VBA Rest API - DHL Return label - 401

Question

I am trying to create a return shipping DHL parcel label with provided DHL api in the sandbox: https://developer.dhl.com/api-reference/parcel-de-returns-post-parcel-germany#get-started-section/user-guide

With postman it works. But I would like to implement the HTTP Request in VBA. I always receive status 401 Unauthorized

I guess it is the way how I pass the credentials. Anyone has an idea how to get it working?

create return labels in the sandbox, with the following user data: Username: "2222222222_customer" Password: "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"":""+49 421 987654321"", " _
    & " ""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

Many thanks :)

Alex

Answer 1

If apiKey is a variable, then you should leave the quotes out in: .setRequestHeader "dhl-api-key", "apiKey"