Vba 尝试在我的MS Access数据库程序中集成HTTP GET请求

我想使用来自MS Access程序的HTTP GET请求从信用卡处理公司Anedot导入数据。Anedot使用RESTful API，并在其网站上提供了帮助：

我想用VBA实现这一点，并将导入与MS Access窗体上的按钮相关联。我已经读到，这只可能与XML。我是否使用VBA创建XML文件

我非常感谢一些关于如何完成这项工作的背景信息，因为大部分信息都在我的头上飞过。我真的不知道从哪里开始，我很难在谷歌上找到任何有用的东西

到目前为止，我已经意识到我需要通过URL链接（他们提供）引用他们的API，并且我必须使用我的用户名和令牌ID来授权我的帐户。但是我如何在VBA中做到这一点

---

谢谢

老实说，这是一个相当长的问题，但让我们从一些代码开始

该类模块（“

clsXMLHttpMonitor

”）应该有助于：

Option Explicit


Dim XMLHttpReq As MSXML2.ServerXMLHTTP

Dim RequestedVar As String
Dim P As Object

Public Sub Initialize(ByVal uXMLHttpRequest As Object, Optional RequestedValue As String = "")
   RequestedVar = RequestedValue
   Set XMLHttpReq = uXMLHttpRequest
End Sub

Sub ReadyStateChangeHandler()
    If XMLHttpReq.ReadyState = 4 Then
        If XMLHttpReq.Status = 200 Then
            'Process the response here
            Debug.Print "200 recieved"
            Set P = JSON.parse(XMLHttpReq.responseText)
        Else
            If XMLHttpReq.Status = 404 Then
                'Handle it
            End If
        End If
    End If

End Sub

Function returnResponseHeaders() As String
returnResponseHeaders = XMLHttpReq.getAllResponseHeaders
XMLHttpReq.Send
End Function

Function returnFullText() As String
If XMLHttpReq.ReadyState = 4 Then
    If XMLHttpReq.Status = 200 Then
        returnFullText = XMLHttpReq.responseText
    Else
        returnFullText = "-1"
    End If
Else
    returnFullText = ""
End If
End Function

End Function

像这样使用它：

Set XMLHttpReq = New MSXML2.ServerXMLHTTP
Set XMLHttpMon = New clsXMLHttpMonitor
XMLHttpMon.Initialize XMLHttpReq
XMLHttpReq.OnReadyStateChange = XMLHttpMon
XMLHttpReq.Open "POST", URL, True
XMLHttpReq.Send strPayload

---

由于您似乎要从URL请求Json响应，因此可以在这里研究Json模块，以获得在集合中收集Json响应的完整实现，然后可以在代码中使用该实现或将其保存到表中。有关示例，请参见演示模块：

---

首先，尝试使用基本授权向API发出请求。以下面的代码为例：

Sub Test()

    ' API URL from https://anedot.com/api/v2
    sUrl = "https://api.anedot.com/v2/accounts"
    ' The username is the registered email address of your Anedot account
    sUsername = "mymail@example.com"
    ' The password is your API token
    sPassword = "1e56752e8531647d09ec8ab20c311ba928e54788"
    sAuth = TextBase64Encode(sUsername & ":" & sPassword, "us-ascii") ' bXltYWlsQGV4YW1wbGUuY29tOjFlNTY3NTJlODUzMTY0N2QwOWVjOGFiMjBjMzExYmE5MjhlNTQ3ODg=
    ' Make the request
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", sUrl, False
        .SetRequestHeader "Authorization", "Basic " & sAuth
        .Send
        Debug.Print .ResponseText
        Debug.Print .GetAllResponseHeaders
    End With

End Sub

Function TextBase64Encode(sText, sCharset) ' 05 10 2016
    Dim aBinary
    With CreateObject("ADODB.Stream")
        .Type = 2 ' adTypeText
        .Open
        .Charset = sCharset ' "us-ascii" for bytes to unicode
        .WriteText sText
        .Position = 0
        .Type = 1 ' adTypeBinary
        aBinary = .Read
        .Close
    End With
    With CreateObject("Microsoft.XMLDOM").CreateElement("objNode")
        .DataType = "bin.base64"
        .NodeTypedValue = aBinary
        TextBase64Encode = Replace(Replace(.Text, vbCr, ""), vbLf, "")
    End With
End Function

将您的凭证放入

sUsername

和

sPassword

变量，从中选择适当的URL并将其放入

sURL

。然后您可以解析来自服务器的JSON响应（当前您将在即时窗口中看到

/v2/accounts

请求的响应）