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