【vba源码】自动获取汇率

Hi，大家好！

没有想到今天居然是腊八，过了腊八就是年，离过年越来越近了，那在这里给大家就拜个年，希望大家在新的一年都有好事发生。

最近在弄点小项目，在项目遇到了一个汇率计算的问题，需要把人民币按市场的汇率转换成美元与欧元，因为考虑到汇率是每天都在变化的，如果每天都手工输入汇率，虽然花不了多少时间，但是很麻烦，如果能自动获取最新的汇率那是多么方便。既然，我们有这个想法了，那我们就动手吧！动手之前，大家先给我一个小爱心吧，谢谢大家啦！

0 1、建表

首先，我先来创建一张表，用于存放每天的汇率数据，具体的如图

0 2、创建窗体

接着，我们用表创建一个数据表窗体，把数据表窗体做为子窗体，放在窗体中，具体的如图

主窗体上有个文本框，文本框的控件来源为：=[F_汇率_List]![汇率] & [F_汇率_List]![币种]

0 3、添加获取代码

在准备工作完成后，我们就可以来添加代码了，我们先来讲一下原理，这次的功能实现比较麻烦，大家可以耐心的看一下。我们为了实现自动获取数据，那肯定需要用到接口，那这里的接口链接为：https://api.exchangerate-api.com/v4/latest/USD

有了接口，我们就可以来调用了，具体的调用过程为：

vbscript 复制代码

Sub GetExchangeRate()

On Error GoTo Err

    Dim http As Object

    Dim Json As Object

    Dim url As String

    Dim rate As String

    Dim sSQL As String

    

    ' 创建HTTP对象

    Set http = CreateObject("MSXML2.XMLHTTP")

    

    ' 设置API URL，这里使用的是一个假设的URL，你需要替换为实际的API URL

    ' 例如：url = "https://v6.exchangerate-api.com/v6/YOUR_API_KEY/latest/USD"

    url = "https://api.exchangerate-api.com/v4/latest/USD"

    

    ' 发送HTTP请求

    http.Open "GET", url, False

    http.Send

    

    ' 检查HTTP请求是否成功

    If http.Status = 200 Then

        ' 使用JSON解析器解析响应

        Set Json = JsonConverter.ParseJson(http.responseText)

        

        ' 从JSON对象中获取汇率数据

        If Nz(DLookup("日期", "T_汇率", "日期=#" & Json("date") & "#"), "") = "" Then

            sSQL = "insert into T_汇率(币种,汇率,日期)values('CNY'," & Json("rates")("CNY") & ",#" & Json("date") & "#)"

            CurrentDb.Execute sSQL

            sSQL = "insert into T_汇率(币种,汇率,日期)values('EUR'," & Json("rates")("EUR") & ",#" & Json("date") & "#)"

            CurrentDb.Execute sSQL

            sSQL = "insert into T_汇率(币种,汇率,日期)values('JPY'," & Json("rates")("JPY") & ",#" & Json("date") & "#)"

            CurrentDb.Execute sSQL

        End If

        

    Else

        MsgBox "无法获取汇率数据。HTTP错误码: " & http.Status

    End If

    Me.F_汇率_List.Requery

    MsgBox "获取成功", vbInformation

ExitHere:

    ' 释放对象

    Set http = Nothing

    Set Json = Nothing

    Exit Sub

Err:

    MsgBox Err.Description, vbCritical, "#Error"

    Resume ExitHere

End Sub

0 4、单击事件

接着，我们在按钮的单击事件调用这个过程，代码非常简单

vbnet 复制代码

Private Sub btnGetData_Click()

    Call GetExchangeRate

End Sub

0 5、代码解释

最后，我们来解释一下代码。

我们在调用接口后，会返回一段Json数据，部分截图：

这个时候，我们就需要去使用JSON解析器解析响应，那vba该怎么去解析呢？这个时候，我们就要借助一些工具了，我在github上找到了一个解析的开源代码，具体的地址：

https://github.com/VBA-tools/VBA-JSON

感谢这位原作者，这样的话，我们就可以很简单实现解析了。

首先，我们要把该作者的一段通用模块（JsonConverter.bas）放到我们的系统中，接着，我们就可以调用了，比如这段代码：

Set Json = JsonConverter.ParseJson(http.responseText)

Json("rates")("CNY")

0 6、测试使用

最后，我们就可以来测试一下了！

效果还是挺不错的！

大家如果觉得我写的还行，那就给我一键三链吧！