VBA Rest API - DHL 退货标签 - 401

Question

我正在尝试使用沙盒中提供的 DHL api 创建退货 DHL 包裹标签： https://developer.dhl.com/api-reference/parcel-de-returns-post-parcel-germany#get-started-section/user-guide

使用邮递员就可以了。但我想在VBA中实现HTTP请求。 我总是收到状态 401 未经授权

我想这就是我传递凭证的方式。 有人知道如何让它工作吗？

在沙箱中创建退货标签，其中包含以下用户数据： 用户名：“2222222222_customer” 密码：“uBQbZ62！ZiBiVVbhc”

Sub restAPICall()
Dim objRequest As MSXML2.ServerXMLHTTP60
Dim id_header_name As String, id_key As String, secret_header_name As String, secret_key As String
Dim strUrl As String
Dim blnAsync As Boolean
Dim strResponse As String
Dim json As Object
Dim authKey As String
Set objRequest = New ServerXMLHTTP60
strUrl = "https://api-sandbox.dhl.com/parcel/de/shipping/returns/v1/orders?labelType=BOTH" 'Endpoint Test
blnAsync = False

id_key = "2222222222_customer"
pass = "uBQbZ62!ZiBiVVbhc"

apiKey = "123456789"

body = "{""receiverId"":""deu"", " _
& " ""customerReference"":""Kundenreferenz"", " _
& " ""shipmentReference"":""Sendungsreferenz"", " _
& " ""shipper"": { " _
    & " ""name1"":""Absender Retoure Zeile 1"", " _
    & " ""name2"":""Absender Retoure Zeile 2"", " _
    & " ""name3"":""Absender Retoure Zeile 3"", " _
    & " ""addressStreet"":""Charles-de-Gaulle Str."", " _
    & " ""addressHouse"":""20"", " _
    & " ""city"":""Bonn"", " _
    & " ""email"":""[email protected]"", " _
    & " ""phone"":""[phone]"", " _
    & " ""postalCode"":""53113"", " _
    & " ""state"":""NRW"", " _
& " }, " _
& " ""itemWeight"": { " _
    & " ""uom"": ""g"", " _
    & " ""value"":""1000"", " _
& " }, " _
& " ""itemValue"": { " _
    & " ""currency"": ""EUR"", " _
    & " ""value"":""100"", " _
& " }, " _
& "}"

With objRequest
    .Open "POST", strUrl, blnAsync ', gkpuser, gkpass
    .setRequestHeader "Authorization", "Basic " + EncodeBase64(id_key + ":" + pass)
    .setRequestHeader "Content-Type", "application/json"
    .setRequestHeader "Accept", "application/json"
    .setRequestHeader "dhl-api-key", "apiKey"
    .Send body
    
    While objRequest.readyState <> 4
        DoEvents
    Wend
    
    strResponseHeaders = .StatusText
    strResponse = .responseText
    allResponseHeader = .GetAllResponseHeaders
End With

Debug.Print body
Debug.Print allResponseHeader
Debug.Print strResponse

End Sub

Function EncodeBase64(text$)
    Dim b
    With CreateObject("ADODB.Stream")
        .Open: .Type = 2: .Charset = "utf-8"
        .WriteText text: .Position = 0: .Type = 1: b = .Read
        With CreateObject("Microsoft.XMLDOM").createElement("b64")
            .DataType = "bin.base64": .nodeTypedValue = b
            EncodeBase64 = Replace(Mid(.text, 5), vbLf, "")
        End With
        .Close
    End With
End Function

非常感谢:)

亚历克斯

Answer 1

如果 apiKey 是变量，那么您应该将引号省略： .setRequestHeader“dhl-api-key”，“apiKey”

Answer 2

希望这对其他人有帮助！我已经用 C# 实现了 DPD、GLS 和 DHL 的 API 接口，可以轻松调整或用作灵感： https://github.com/kevinvenclovas/ShippingProAPICollection/blob/main/ShippingProAPICollection/Provider/DHL/DHLShipmentService.cs