Save Excel Workbook which is retrieved from API-CodePudding

I have a code which retrieves information from an API. I do get response but here is the tricky part. The response of the API is an Excel file (.xlsx). So when I use the endpoint, I receive an Excel workbook.

My code is as follows (I substituted the links and passwords obviously):

    Dim objJsonObject, objRequest As Object
    Dim strUrl, strBody As String
    Dim intCount As Integer
    Dim blnAsync As Boolean
    
    Me.chbToken.Value = False
    
    With Me.boxTabellen
        .Clear
        .AddItem "Locaties"
        .AddItem "Adressen"
        .AddItem "Zaken"
    End With
        
    Set objRequest = CreateObject("MSXML2.XMLHTTP")
    strUrl = "https://xxx.xxxxx.xx/xxx/xxxx"
    strBody = "{" & Chr(34) & "username" & Chr(34) & ":" & Chr(34) & "xxxxx" & Chr(34) & "," & Chr(34) & "password" & Chr(34) & ":" & Chr(34) & "xxxxx" & Chr(34) & "," & Chr(34) & "group" & Chr(34) & ":" & Chr(34) & "xxxxxx" & Chr(34) & "," & Chr(34) & "deleteOtherSessions" & Chr(34) & ":true}"
    
    With objRequest
        .Open "Post", strUrl
        .setRequestHeader "authority", "xxxx.xxxxx.xx"
        .setRequestHeader "method", "POST"
        .setRequestHeader "path", "/api/Token"
        .setRequestHeader "scheme", "https"
        .setRequestHeader "accept", "application/json"
        .setRequestHeader "accept-encoding", "gzip,deflate,br"
        .setRequestHeader "accept-language", "nl-NL,nl;q=0.9,en-US;q=0.8,en;q=0.7"
        .setRequestHeader "cache-control", "no-cache"
        .setRequestHeader "content-length", "103"
        .setRequestHeader "authorization", "bearer"
        .setRequestHeader "content-type", "application/json"
        .setRequestHeader "dnt", "1"
        .setRequestHeader "expires", "Sat,01Jan200000:00:00GMT"
        .setRequestHeader "origin", "https://xxxx.xxxxx.xx"
        .setRequestHeader "pragma", "no-cache"
        .setRequestHeader "referer", "https://xxxx.xxxxx.xx"
        .setRequestHeader "sec-fetch-dest", "empty"
        .setRequestHeader "sec-fetch-mode", "cors"
        .setRequestHeader "sec-fetch-site", "same-origin"
        .setRequestHeader "sec-gpc", "1"
        .setRequestHeader "user-agent", "Mozilla/5.0(WindowsNT10.0;Win64;x64)AppleWebKit/537.36(KHTML,likeGecko)Chrome/104.0.5112.81Safari/537.36"
        .setRequestHeader "Content-type", "application/json; charset=utf-8"
        .send (strBody)
        While objRequest.readyState <> 4
            DoEvents
        Wend
        strResponse = .responseText

In the end I store the response in a variable (strResponse). If I look at what the response is, we see an Excel workbook:

?objRequest.responseText
PK   TU2{FU<  ?   [Content_Types].xml ?(?                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 ???1?e??8cX8?W???m?³y?g?x0??|?/}}???kH???
?
?E???6?<m#?>7?C?7Bd?????*mHN"????R-?x8?*x?5???V?,V????U?;a????%???I?4?31H?qQJ??????t$ ^BZ>?????(?????; t???;i????.<??o? ?9??l~#f???bzM??????d  ?H???}*?2Q.??K     ! ?U0#?L   _rels/.rels ?(?                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 ??MO???????BKwAH?!T~?I????$?'T?G?~????;#?w????&r?Fq??v???GJy(v??*????K?#F?D??W   ??=??Z?Y??S???7???????9L??bg?|?!?Sh9i?b?r:"y_dl?D???R"4?%??4??   ë?????  ?? PK   TU?  ?   xl/_rels/workbook.xml.rels ?(?                                                            
                                                                                                                                                                                                     ??Kn???b;?<??M7lp??$?e-?????4U????^??C/^?? Y?? ?m?F??W???.?8b????#??Bb????tJ????wL?bwr????????????[N"H?????V?????G??R|??j??i??F?\%?Y1?f???\} PK   TUl?^?  $     xl/workbook.xml??MO???????HhW??pv?????$?N?w???7Q{WS??'??W??W%%1    ????H??þ??j??YeVe?]? ð?? ??,????H(;?z?Y????6:g??_8V??o?? T?5?`y????s>????|?g?d???????C?1?5?~?s??$?,???<??)??XE??V&=?&???h?J?ëv?5????????(??w]?i?n???????????????e?
??/?R??u
[onT??YW
#??q?[??PK   TU&?? ?

If I write that string to a .xlsx file:

strBestandsnaam = strLocatie & Format(Now, "ddmmyyyyhhmmss") & "_download_" & strTabel & ".xlsx"            
Open strBestandsnaam For Output As #1
Print #1, .responseText
Close #1

When I open de .xlsx file, there is an error. It cannot be opened because the file is damaged (according to Excel). Apparently this is not the way to store the information, how can I retrieve the information and save is as an Excel workbook?

EDIT: After consulting @funthomas: I removed all headers I can miss. So the new code is:

With objRequest
    .Open "Get", strUrl
    .send
        While objRequest.readyState <> 4
        DoEvents
    Wend
    
    intBestand = FreeFile
    
    Open strBestandsnaam For Binary Access Write As #intBestand

    Put #intBestand, , .responseText

    Close #1
End With

But still the same problem

CodePudding user response：

Not sure if this works in your specific case, but I assume the reason for your problem is caused by the fact that the file is not opened in binary mode and that you use Print. Try the following code, I have used it many times writing binary data (eg a Blob from a database) to a file.

Dim file as Integer
file = FreeFile
Open strBestandsnaam For Binary Access Write As #file
Put #file, ,.responseText 
Close #file

CodePudding user response：

This uses a GET but assuming your file is returned correctly it should work with your POST:

Sub SaveBinaryResponse()
    
    Const URL = "https://www.blue-bird.com/images/vision2.png"
    
    Dim xmlhttp As Object, strm As Object
    
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    xmlhttp.Open "GET", URL, False
    xmlhttp.send
    
    'Use an ADODB stream to save the response to disk
    With CreateObject("ADODB.Stream")
        .Open
        .Type = 1 'adTypeBinary
        .write xmlhttp.responseBody 'not responseText
        .SaveToFile "C:\Temp\test.png", 2
        .Close
    End With
End Sub