excel VBA API集成-空返回

krcsximq  于 2023-02-05  发布在  其他
关注(0)|答案(1)|浏览(127)

我有一个问题。我有一个网站,我想通过这个网站拉数据。我写了一个VBA代码,但似乎它总是返回空,即使有数据。以下是代码;

Sub dataxx()
Dim request As New WinHttpRequest
request.Open "Get", "https://api.ibb.gov.tr/ispark/ParkDetay?id=45"
request.Send

If request.Status <> 200 Then
    MsgBox request.ResponseText
    Exit Sub
End If

Dim response As Variant
Set response = JsonConverter.ParseJSON(request.ResponseText)
Dim parkArray() As String
ReDim parkArray(0 To 0)
On Error Resume Next
Dim locationName As String
locationName = response("locationName")

Dim parkID As Integer
parkID = response("parkID")

Dim parkName As String
parkName = response("parkName")

Dim lat As Double
lat = response("lat")

Dim lng As Double
lng = response("lng")

Dim capacity As Integer
capacity = response("capacity")

Dim emptyCapacity As Integer
emptyCapacity = response("emptyCapacity")

Dim updateDate As Date
updateDate = response("updateDate")

Dim workHours As String
workHours = response("workHours")

Dim parkType As String
parkType = response("parkType")

Dim freeTime As Integer
freeTime = response("freeTime")

Dim monthlyFee As Double
monthlyFee = response("monthlyFee")

Dim tariff As String
tariff = response("tariff")

Dim district As String
district = response("district")

Dim address As String
address = response("address")

Dim areaPolygon As String
areaPolygon = response("areaPolygon")

parkArray(15) = Array(locationName, parkID, parkName, lat, lng, capacity, emptyCapacity, updateDate, workHours, parkType, freeTime, monthlyFee, tariff, district, address, areaPolygon)

End Sub

你们怎么看?代码有什么问题。如果我没有把“错误恢复下一个”,然后我得到一个错误“无效的过程调用或参数”。有人能帮助我吗?

h9vpoimq

h9vpoimq1#

json是一个记录数组,因此必须使用response(1)("parkName")

[
    {
    "parkName": "H\u00fcsrev Gerede Sokak 1",
    "parkType": "YOL \u00dcST\u00dc",
    "updateDate": "02.02.2023 16:15:18",
    "workHours": "08:00-19:00"
    }
]

Option Explicit

Sub dataxx()

    Dim request As New WinHttpRequest, response As Variant
    Dim field, parkArray(), i As Long, msg As String

    request.Open "Get", "https://api.ibb.gov.tr/ispark/ParkDetay?id=45"
    request.Send
    
    If request.Status <> 200 Then
        MsgBox request.ResponseText, vbExclamation
        Exit Sub
    End If
    
    field = Array("locationName", "parkID", "parkName", "lat", "lng", _
    "capacity", "emptyCapacity", "updateDate", "workHours", "parkType", _
    "freeTime", "monthlyFee", "tariff", "district", "address", "areaPolygon")
    
    ReDim parkArray(0 To UBound(field))
    Set response = JsonConverter.ParseJson(request.ResponseText)
    
    With response(1)
        For i = 0 To UBound(parkArray)
            parkArray(i) = .Item(field(i))
            msg = msg & vbLf & field(i) & "=" & parkArray(i)
        Next
    End With
    MsgBox msg, vbInformation
   
End Sub

相关问题