【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、测试使用

最后,我们就可以来测试一下了!

效果还是挺不错的!

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

相关推荐
UrbanJazzerati2 小时前
Excel 神器 COUNTIFS 函数详解:多条件计数实战
excel
想学习java初学者20 小时前
SpringBoot整合Fastexcel/EasyExcel导出Excel导出单个图片
excel
LAM LAB1 天前
【WPS】office邮件合并,怎么将数据源excel中的下一条拼接在文档中的下一个位置
excel·wps
SEO-狼术1 天前
Document Solutions for Excel, .NET
excel
Smartdaili China2 天前
使用抓取 API 可靠高效地提取亚马逊 (Amazon)数据
python·api·亚马逊爬虫·亚马逊代理·amazon代理ip·亚马逊爬取·亚马逊数据
Access开发易登软件2 天前
Access开发一键删除Excel指定工作表
服务器·前端·后端·excel·vba·access·access开发
Saggitarxm2 天前
Golang实现 - 实现只有表头的 Excel 模板,并在指定列添加了下拉框功能。生成的 Excel 文件在打开时,指定列的单元格会显示下拉选项
excel·下拉框选项序列·生成excel模板·下拉框选项
pk_xz1234562 天前
SAP全自动化工具开发:Excel自动上传与邮件通知系统
运维·人工智能·windows·深度学习·分类·自动化·excel
俊昭喜喜里3 天前
Excel——设置打印的区域
excel
开开心心就好4 天前
Excel数据合并工具:零门槛快速整理
运维·服务器·前端·智能手机·pdf·bash·excel