我正在尝试发送包含订单详情的消息。我尝试过以下代码来获取产品详细信息。当订单只包含一个产品时,代码可以正常工作,如果订单中有多个产品消息将不会被发送。
Option Explicit
Sub Test()
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aData()
Dim aHeader()
' Retrieve data
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://data.fixer.io/api/latest?access_key=209f86f5304e0043a0879d8cb45c9c10&symbols=USD,CNY,INR,THB,SGD,AUD", False
.Send
sJSONString = .ResponseText
End With
' Parse JSON response
JSON.Parse sJSONString, vJSON, sState
' Refer to target dictionary containing rates
Set vJSON = vJSON("rates")
' Access to each item in dictionary
Debug.Print vJSON("USD")
Debug.Print vJSON("CNY")
Debug.Print vJSON("INR")
Debug.Print vJSON("THB")
Debug.Print vJSON("SGD")
Debug.Print vJSON("AUD")
' Convert to array and output to worksheet
JSON.ToArray vJSON, aData, aHeader
With Sheets(1)
.Cells.Delete
.Cells.WrapText = False
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "@"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "@"
.Value = aCells
End With
End With
End Sub
我不知道什么是错的。