我想使用来自MS Access程序的HTTP GET请求从信用卡处理公司Anedot导入数据。 Anedot使用RESTful API并在网站上提供了帮助:https://anedot.com/api/v2
我希望使用VBA执行此操作,并将导入与MS Access表单上的按钮相关联。我已经读过,这只能通过XML实现。我是否使用VBA创建XML文件?
我非常感谢有关如何完成这项工作的一些背景信息,因为大多数信息都是在我脑海中浮现。我真的不知道从哪里开始,我在谷歌上找不到任何有用的东西。
到目前为止,我已经意识到我需要通过URL链接(他们提供)来引用他们的API,并且我必须使用我的用户名和令牌ID来授权我的帐户。但是我怎么能在VBA中做到这一点?
感谢。
答案 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
将您的凭据放到sUsername
和sPassword
个变量中,从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响应,然后您可以在代码中使用它或保存到表中。有关示例,请参阅演示模块: