用于在Excel中提取API URL结果的VBA代码

Question

我有一个 API URL 可以在 JSON {"visit":"0","sales":"0"} 中获取一个简单的结果。

问题是 URL 一次仅适用于 1 个参数，并且我有数百个条目要映射。

下面是网址

http://<Website>/lms/lmsapi.php?mobileno=<10digits-mobileNumber>&leaddate=<yyyy-mm-dd>

我只需要更改"<>"之间的值。

我已经准备好了包含所有条目的 excel 文件，任何新条目都将创建一个替换上述值的自定义 URL。

我需要VBA script才能在条目旁边的单元格中的Excel文件中获取结果。

Answer 1

Sub XMLHttpTest()
    ' Dim Variables
    Dim XMLHttp     As Object
    Dim ApiUrl      As String, ApiRequestType As String, ApiUser As String
    Dim ApiPwd      As String
    Dim bolAsync    As Boolean
    Dim ApiMsg                  ' <----mostly for Post
    Dim r           As Range
    'create Microsoft XML HTTP Objekt
    Set XMLHttp = CreateObject("MSXML2.XMLHTTP")
    'Set ScriptControl for parsing JSON
    Set ScriptControl = CreateObject("ScriptControl"): ScriptControl.Language = "JScript"

    'Loop through every Used Cell in A
    With ActiveSheet
        For Each r In Intersect(.Range("a:a"), .UsedRange) ' <- i assume your urls are saved in column A if not change a:a to whatever you need
            ' Add the parameters for our request
            ApiRequestType = "GET"
            ApiUrl = r.Value
            bolAsync = False
            ApiUser = ""
            ApiPwd = ""
            ApiMsg = ""
         ' execute Request
            Call XMLHttp.Open(ApiRequestType, ApiUrl, bolAsync, ApiUser, ApiPwd)
            Call XMLHttp.send(ApiMsg)
            MsgBox XMLHttp.responseText
            If XMLHttp.Status <> 200 Then
                MsgBox "The Request returned " & XMLHttp.Status & XMLHttp.statusText
            Else
                Set jsonDecode = ScriptControl.Eval("(" + XMLHttp.responseText + ")")
                Cells(r.Row, r.Column + 1).Value = jsonDecode.visit
                Cells(r.Row, r.Column + 2).Value = jsonDecode.sales
            End If

        Next
    End With
    MsgBox "Request successfull."
End Sub

Sry，花了这么长时间，但我有一些忙碌的日子。我认为上面的代码应该可以解决您的问题。确保只在您信任的 API 上使用它，因为 ScriptControl 可以接受 JAVA 命令并执行它们，因此请记住这一点如果您想接受其他状态消息，那么 200 只需更改

If XMLHttp.Status <> 200 

满足您的需求