WinHTTPrequest and MSXML2.DOMDocument60

lzr

Board Regular
Joined
Aug 31, 2007
Messages
52
I'm trying to put together a macro that will access a site's API and download files.

First, it accesses the site and searches for a particular document. If it is found, the site returns various information about the document, one item being the 'view_address', which is the url to view or download the document. Below is part of the code. It seems to work down to just before the MSXML2.DOMDocument60 portion. So, the Debug.Print WHttp.responseText returns all the information about my particular document.

Next, I need to get the url link that is at "view_address", as seen in the below snippet of what is returned at WHttp.responseText.
],
"images": [
{
"number": 5294136,
"book": "000692",
"page": "0347",
"view_address": "\/api\/v1\/images?city=NYC&number=5294136&action=view"


I'm trying to load this information so that the portion I want can be extracted, but xmlDoc.LoadXML(SearchResponse) does not work. The Msgbox "Load Error" shows and it appears that xmldoc is blank.

Clearly I'm stumbling around and don't know what I'm doing, but can anyone offer any ideas of what I'm doing wrong?

Thanks in advance.

Code:
WHttp.Open "GET", FullSearchPath, False
'WHttp.setRequestHeader "Authorization", "Basic " & APIToken
WHttp.SetCredentials APIToken, APIToken, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
WHttp.send

SearchResponse = WHttp.responseText

Debug.Print WHttp.responseText

Dim xmlDoc As New MSXML2.DOMDocument60

    If Not xmlDoc.LoadXML(SearchResponse) Then
         MsgBox "Load Error"
    End If
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
The response looks like JSON, not XML. There are several JSON parsers you could use, but the following code uses string functions to extract the view_address:
Code:
    Dim p1 As Long, p2 As Long, view_address As String
    
    p1 = InStr(WHttp.responseText, """view_address"": ") + Len("""view_address"": ") + 1
    p2 = InStr(p1, WHttp.responseText, Chr(34))    
    view_address = Replace(Mid(WHttp.responseText, p1, p2 - p1), "\", "")
    Debug.Print view_address
 
Upvote 0
The response looks like JSON, not XML. There are several JSON parsers you could use, but the following code uses string functions to extract the view_address:
Code:
    Dim p1 As Long, p2 As Long, view_address As String
    
    p1 = InStr(WHttp.responseText, """view_address"": ") + Len("""view_address"": ") + 1
    p2 = InStr(p1, WHttp.responseText, Chr(34))    
    view_address = Replace(Mid(WHttp.responseText, p1, p2 - p1), "\", "")
    Debug.Print view_address

Thank you, this works great.

So, then I inserted the following:

Code:
WHttp.Open "GET", BaseAddress & view_address, False
'WHttp.setRequestHeader "Authorization", "Basic " & APIToken
WHttp.SetCredentials APIToken, APIToken, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
WHttp.send

I believe that the code should be the equivalent of typing the url in a browser, which leaves me looking at a pdf of my document. Now I'd like to download and saveAs the file as "B-P.pdf" to a folder called "Test Folder" on "C:". Any guidance or ideas on how to do that?

And a side question, is the .setcredentials way that I'm passing the API token the best way to handle this? It works, but doesn't look quite right to me. The site simply wants the APIToken and their documentation says Basic authentication. But the way I've entered it here is the only way I've gotten it to work.

Thanks again for your help.
 
Last edited:
Upvote 0
Try this to download the file:
Code:
    Dim fileNum As Integer, buffer() As Byte
    fileNum = FreeFile
    Open "C:\Folder\file.pdf" For Binary Access Write As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fileNum]#fileNum[/URL] 
    buffer = WHttp.responseBody
    Put [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fileNum]#fileNum[/URL] , , buffer
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fileNum]#fileNum[/URL]
I don't know about the API token because I don't know which API you're using. With basic authentication some sites require the token to be encoded as a base64 string, but it all depends on the API.
 
Upvote 0
The response looks like JSON, not XML. There are several JSON parsers you could use, but the following code uses string functions to extract the view_address:
Code:
    Dim p1 As Long, p2 As Long, view_address As String
    
    p1 = InStr(WHttp.responseText, """view_address"": ") + Len("""view_address"": ") + 1
    p2 = InStr(p1, WHttp.responseText, Chr(34))    
    view_address = Replace(Mid(WHttp.responseText, p1, p2 - p1), "\", "")
    Debug.Print view_address

Thanks, I think I'm on the home stretch. As it turns out, my results could contain several instances of 'view_address'. Is there a way for the above code to reflect the first 'view_address' and ignore any others?
 
Upvote 0
Please ignore #5 , I was wrong in how the API worked. The API actually returns a 'view_address' tag and information for every page in the document. So, I need to cycle through all the 'view_address' tags and info found in Whttp.responseText, then when done, combine them all together in one document and save locally. Or append each new page as it finds more 'view_page' items and then download the result. Any thoughts or ideas?

Below is a rough example of what whttp.responseText might look like.

],
"images": [
{
"number": 5294136,
"book": "000692",
"page": "0347",
"view_address": "\/api\/v1\/images?city=NYC&number=5294136&action=view"

"number": 5294137,
"book": "000692",
"page": "0348",
"view_address": "\/api\/v1\/images?city=NYC&number=5294137&action=view"
 
Upvote 0
Try this:
Code:
    Dim p1 As Long, p2 As Long, view_address As String
    
    p1 = 1
    Do
        p1 = InStr(p1, WHttp.responseText, """view_address"": ", vbTextCompare)
        If p1 <> 0 Then
            p1 = p1 + Len("""view_address"": ") + 1
            p2 = InStr(p1, WHttp.responseText, Chr(34))
            view_address = Replace(Mid(WHttp.responseText, p1, p2 - p1), "\", "")
            Debug.Print view_address
            p1 = p2 + 1
        End If
    Loop While p1 <> 0
 
Upvote 0
Try this:
Code:
    Dim p1 As Long, p2 As Long, view_address As String
    
    p1 = 1
    Do
        p1 = InStr(p1, WHttp.responseText, """view_address"": ", vbTextCompare)
        If p1 <> 0 Then
            p1 = p1 + Len("""view_address"": ") + 1
            p2 = InStr(p1, WHttp.responseText, Chr(34))
            view_address = Replace(Mid(WHttp.responseText, p1, p2 - p1), "\", "")
            Debug.Print view_address
            p1 = p2 + 1
        End If
    Loop While p1 <> 0

Would it be better to loop through and save all the view_addresses in an array and then use the array to build my document, or find a view_address and add/append it to a file, find the next view_address and append it and so on..?
 
Upvote 0

Forum statistics

Threads
1,214,823
Messages
6,121,779
Members
449,049
Latest member
greyangel23

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top