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

时间:2016-10-01 05:37:09

标签: vba http web-scraping access-vba xmlhttprequest

我想使用来自MS Access程序的HTTP GET请求从信用卡处理公司Anedot导入数据。 Anedot使用RESTful API并在网站上提供了帮助:https://anedot.com/api/v2

我希望使用VBA执行此操作,并将导入与MS Access表单上的按钮相关联。我已经读过,这只能通过XML实现。我是否使用VBA创建XML文件?

我非常感谢有关如何完成这项工作的一些背景信息,因为大多数信息都是在我脑海中浮现。我真的不知道从哪里开始,我在谷歌上找不到任何有用的东西。

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

感谢。

3 个答案:

答案 0 :(得分:1)

首先尝试使用基本授权向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

将您的凭据放到sUsernamesPassword个变量中,从API help page中选择相应的网址并将其放入sURL。然后,您可以解析来自服务器的JSON响应(目前您将在立即窗口中看到/v2/accounts请求的响应。)

答案 1 :(得分:0)

说实话,这是一个相当冗长的问题,但让我们从一些代码开始,让你前进。

此课程模块(“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

答案 2 :(得分:0)

当您似乎从URL请求Json响应时,您可以在此处学习Json模块以获取完整实现,该实现收集集合中的Json响应,然后您可以在代码中使用它或保存到表中。有关示例,请参阅演示模块:

VBA.CVRAPI