通过 VBA 访问 REST API 会返回“无效 ID/密钥”错误

Question

我正在尝试通过 VBA 代码访问 Appointments-Plus.com API，并且一直被告知我给它的站点 ID/密钥无效。我使用的是 Office365 版本的 Access。

This is the relevant documentation for this API call.

当我使用 Postman 测试 API 时，我能够成功连接并取回数据。邮递员整理的网址是这样的：

https://ws.appointment-plus.com/Locations/GetLocations?Authorization:Basic=<site-ID>:<Key>&response_type=xml

我的 VBA 代码是这样的：

Public Sub RESTtestBigURL()

  Dim responseType As String
  responseType = "response_type=json"

  Dim restRequest As WinHttp.WinHttpRequest
  Set restRequest = New WinHttp.WinHttpRequest

  Dim restResult As String

  With restRequest
    .Open "POST", "https://ws.appointment-plus.com/Locations/GetLocations?Authorization:Basic=<site-ID>:<Key>&response_type=xml", False
    .Send
    .WaitForResponse
    Debug.Print ".ResponseText: " & .ResponseText
    Debug.Print ".Status: " & .Status
    Debug.Print ".StatusText: " & .StatusText
    Debug.Print ".ResponseBody: " & .ResponseBody
  End With

End Sub

我知道第一个问题是“你确定你的 <site-ID> 和 <key> 正确吗？”是的 - 我已经将 Postman 的整个 URL 复制/粘贴到我的 VBA 代码中，并且我已经让另外几对眼球查看它以确认它们仍然相同。

当我运行该代码时，我得到：

.ResponseText: <?xml version="1.0" encoding="utf-8" ?>
<APResponse>
  <resource>customers</resource>
  <action>getcustomers</action>
  <request></request>
  <result>fail</result>
  <count>0</count>
  <errors>
    <error><![CDATA[Web Services authentication failed: invalid Site ID or API Key]]></error>
  </errors>
</APResponse>

我尝试了其他几种访问 API 的方法，所有这些方法都给我同样的“无效 ID/密钥”错误：

Public Sub SecondRESTtestMSXML()

  Dim restRequest As MSXML2.XMLHTTP60
  Set restRequest = New MSXML2.XMLHTTP60

  With restRequest

    .Open "GET", URL & REQUEST_GET_LOCATIONS, True
    .SetRequestHeader "Authorization", "Basic" & SITE_ID & ":" & API_KEY
    .SetRequestHeader "response_type", "xml"
    .SetRequestHeader "Accept-Encoding", "application/xml"
    .Send "{""response_type"":""JSON""&""location"":""582""}"
    While .ReadyState <> 4
      DoEvents
    Wend
    Debug.Print ".ResponseText: " & .ResponseText
    Debug.Print ".Status: " & .Status
    Debug.Print ".StatusText: " & .StatusText
    Debug.Print ".ResponseBody: " & .ResponseBody

  End With

End Sub

有人建议这是与通过 Base64 编码解决的另一个问题的重复。但是，这种方法虽然不是很明确，但表明我也尝试过。我添加了从这里调用的Base64Encode 函数代码。

Public Sub RESTtest()

  Dim restRequest As WinHttp.WinHttpRequest
  Set restRequest = New WinHttp.WinHttpRequest

  Dim restResult As String

  With restRequest
    .Open "POST", URL & REQUEST_GET_LOCATIONS, True
    .SetRequestHeader "Authorization", "Basic " & SITE_ID & ":" & Base64Encode(API_KEY)
' Note call to Base64Encode() on this line ---------------- ----- ^^^^^^^^^^^^
    .Option(WinHttpRequestOption_EnableRedirects) = False
    .Send "{""response_type"":""JSON""}"
    .WaitForResponse
    Debug.Print ".ResponseText: " & .ResponseText
    Debug.Print ".Status: " & .Status
    Debug.Print ".StatusText: " & .StatusText
    Debug.Print ".ResponseBody: " & .ResponseBody
  End With

End Sub

Public Function Base64Encode(ByVal inputText As String) As String
  Dim xmlDoc As Object
  Dim docNode As Variant
  Set xmlDoc = CreateObject("Msxml2.DOMDocument.3.0")
  Set docNode = xmlDoc.createElement("base64")
  docNode.DataType = "bin.base64"
  docNode.nodeTypedValue = Stream_StringToBinary(inputText)
  Base64Encode = docNode.Text
  Set docNode = Nothing
  Set xmlDoc = Nothing
End Function

注意事项：

• URL、REQUEST_GET_LOCATIONS、SITE_ID 和 API_KEY 是在此模块中全局声明的用于测试目的的常量。它们也都被复制/粘贴，并由几个人检查是否存在拼写错误。
• 您可能会注意到 XML 和 JSON 中都有响应请求 - 它们都给了我相同的响应。
• 我确实收到了 Appt Plus 的支持票，但我希望我能在这里得到更快的响应。

是否有人在此代码中看到任何明显的错误？对尝试调用 API 并获得结果的其他方法有什么建议吗？我曾建议用 C# 编写一个 DLL 并调用它，但是，我没有时间学习足够的 C# 来实现这一点，因此在这里切换语言并不是一个真正的选择。

补充说明：

我在 Powershell 会话中使用 curl 进行了尝试，结果相同：

PS H:\> curl -method Post -uri "https://ws.appointment-plus.com/Locations/GetLocations?Authorization:Basic=<ID>:<key>&response_type=json"

结果：

StatusCode        : 200
StatusDescription : OK
Content           : {"resource":"locations",
                     "action":"getlocations",
                     "request":"",
                     "result":"fail",
                     "count":"0"
                    ,"errors":[
                        "Web Services authentication failed: invalid Site ID or API ...
RawContent        : HTTP/1.1 200 OK
                    Pragma: no-cache
                    Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
                    Date: Mon, 26 Aug 2019 17:28:41 GMT
                    Expires: Thu, 19 Nov 1981 08:52:00 GMT
                    Set-Cooki...
Forms             : {}
Headers           : {[Pragma, no-cache], [Cache-Control, no-store, no-cache, must-revalidate, post-check=0,
                    pre-check=0], [Date, Mon, 26 Aug 2019 17:28:41 GMT], [Expires, Thu, 19 Nov 1981 08:52:00 GMT]...}
Images            : {}
InputFields       : {}
Links             : {}
ParsedHtml        : mshtml.HTMLDocumentClass
RawContentLength  : 207

Answer 1

根据 cmets 中的交换，主要问题似乎是基本授权标头是如何形成的。

对于以后的读者，授权头的格式是：

.SetRequestHeader "Authorization", "Basic " & Base64Encode(SITE_ID & ":" & API_KEY)

另外，您可能遇到的另一个问题与here 有关。使用当前方法将换行符插入到 Base64 编码的字符串中，这对于大多数（如果不是全部）API 来说都不是很好。建议的解决方法如下：

Public Function Base64Encode(ByVal inputText As String, Optional removeBlankLines = True) As String
    Dim xmlDoc As Object
    Dim docNode As Variant
    Set xmlDoc = CreateObject("Msxml2.DOMDocument.3.0")
    Set docNode = xmlDoc.createElement("base64")
    docNode.DataType = "bin.base64"
    docNode.nodeTypedValue = Stream_StringToBinary(inputText)
    Base64Encode = docNode.Text
    Set docNode = Nothing
    Set xmlDoc = Nothing

    'remove blank line characters ASCII --> 10,13,10 + 13
    If removeBlankLines Then Base64Encode = Replace(Replace(Replace(Base64Encode, vbCrLf, vbNullString), vbLf, vbNullString), vbCr, vbNullString)
End Function