【举个栗子】VBA通过http请求获取json数据并显示在ListView中

http请求

Function getJsonData()
    Dim xmlhttp As Object
    Dim url
    url = "" 
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    xmlhttp.Open "GET", url, False '请求方式
    xmlhttp.setRequestHeader "", "" '设置请求头
    xmlhttp.send
   
    Do While xmlhttp.readyState <> 4
        DoEvents
    Loop
    '对于vba的function,函数名就是返回值
    '这里xmlhttp.responseText就是返回的json数据
    getJsonData = xmlhttp.responseText
End Function

转化json

json数据先用本地数据代替一下

{
    	"code":0,
    	"msg":null,
    	"data":[
    		{"fid":"1", "label":"番茄", "value":"tomato"},
    		{"fid":"2", "label":"草莓", "value":"strawberry"}
    	]
}
'窗体初始化
Private Sub UserForm_Initialize()
    Call initialTableHead '初始化表头
End Sub

'初始化表头
Private Sub initialTableHead()
    With ListView1
        .ListItems.Clear
        .View = lvwReport '列表型
        .FullRowSelect = True '选择整行
        .Gridlines = True '显示格线
         .ColumnHeaders.Add , "XH", "XH", 0 '设置listview第一列标题以及第一列宽度,
                                                                    'listview第一列只能向左对齐
        .ColumnHeaders.Add , "fid", "编号", .Width / 8, lvwColumnCenter
        .ColumnHeaders.Add , "label", "显示值", .Width / 8, lvwColumnCenter
        .ColumnHeaders.Add , "trueVal", "真实值", .Width / 8, lvwColumnCenter
    End With
End Sub

'比如点击查询的时侯去获取这个数据显示在表格里,那么就绑定在按钮的点击事件里
Private Sub searchButton_Click()
    ListView1.ListItems.Clear '先清空表格
    
    Dim tableData As String
    tableData = getJsonData()
    'vba里有很多关键字的大小写是固定的,所以要么就让后台传值的时候改一下字段名,要么就只能手动替换了
    tableData = Replace(tableData, """data""", """body""")
    tableData = Replace(tableData, """value""", """trueVal""")
   '创建js的环境,如果报错那就在工具-引用中加上js的引用
    Set tableObj = CreateObject("ScriptControl")
    tableObj.Language = "JScript"
    Set tableJson = tableObj.Eval("tableData=" & tableData)
    
    Dim rowIndex as Integer '下标,listview的下标从1开始
    rowIndex = 1
    Dim fid as String
    Dim label as String
    Dim trueVal as String
    ListView1.SortKey = ListView1.ColumnHeaders("XH").SubItemIndex
    ListView1.Sorted = False
    '遍历body中的数据,要注意判断为空的情况,这个狗屎vba空值会报错的0.0
    For Each tableItem In tableJson.body
        With tableItem
            If IsNull(.fid) Then
                fid = ""
            Else
                fid= .fid
            End If
            
            If IsNull(.label) Then
                label = ""
            Else
                label = .label
            End If
            
            If IsNull(.trueVal) Then
                trueVal = ""
            Else
                trueVal = .trueVal
            End If
            '插入一行表格数据
            Call FillList(rowIndex, fid, label, trueVal)
            rowIndex = rowIndex + 1
        End With
    Next tableItem
    Set tableObj = Nothing
    Set tableJson = Nothing
    Set tableItem = Nothing
End Sub

'填写一行表格
Private Sub FillList(rowIndex As Integer, fid As String, label As String, trueVal As String)

    Dim itmX As ListItem
    
    With ListView1
        Set itmX = .ListItems.Add(1, , CStr(1000000 + rowIndex))
        itmX.SubItems(.ColumnHeaders("fid").SubItemIndex) = fid
        itmX.SubItems(.ColumnHeaders("label").SubItemIndex) = label
        itmX.SubItems(.ColumnHeaders("trueVal").SubItemIndex) = trueVal
    End With
    Set itmX = Nothing
End Sub
  • 1
    点赞
  • 11
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值