xmlHttp not returning any content - VBA

[Drimacus]

Hi All,

Multiple time a day i go to a URL and fill in an HTML form, hit export and this automatically starts downloading an Excel spreadsheet (Chrome). I want to automate my queries to this web service and have tried without success.

Using Google Chrome development tools I have identified the request sent to the server as below (have to remove sensitive info)

• [FONT=Segoe UI, Tahoma, sans-serif]Remote Address:[/FONT][FONT=Consolas, Lucida Console, monospace] ****SENSITIVE****[/FONT]
  
• Request URL:
  ****SENSITIVE***
• Request Method:
  POST
  
• Status Code:
  
  200 OK
  
• Request Headersview source
  • Accept:
    text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8
    
  • Accept-Encoding:
    gzip,deflate,sdch
    
  • Accept-Language:
    en-GB,en-US;q=0.8,en;q=0.6
    
  • Cache-Control:
    max-age=0
    
  • Connection:
    keep-alive
    
  • Content-Length:
    207
    
  • Content-Type:
    application/x-www-form-urlencoded
    
  • Cookie:
    JSESSIONID=****SENSITIVE***; ssoLang=en
    
  • Host:
    ****SENSITIVE***
  • Origin:
    ****SENSITIVE***
  • Referer:
    ****SENSITIVE***
  • User-Agent:
    Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/35.0.1916.114 Safari/537.36
• Query String Parametersview sourceview URL encoded
• Form Dataview sourceview URL encoded
  • ****REQUEST*****
• Response Headersview source
  • Content-Disposition:
    filename="xxx.xlsx"
    
  • Content-Type:
    application/vnd.openxmlformats-officedocument.spreadsheetml.sheet
    
  • Date:
    Sat, 31 May 2014 14:28:25 GMT
    
  • Server:
    Apache-Coyote/1.1
    
  • Transfer-Encoding:
    chunked
    

So the VBA script i have done to send the above request is below :

Sub Download_File()
    Dim localFile As String, URL As String, request As String
    localFile = ThisWorkbook.Path & "\test.xlsx"
    URL = ****SENSITIVE***
    Dim XMLreq As Object 'MSXML2.ServerXMLHTTP
    Set XMLreq = CreateObject("MSXML2.ServerXMLHTTP")
    
    request = ****REQUEST*****


    Dim fileNum As Integer, bytes() As Byte
    With XMLreq
        .Open "POST", URL, False
        .setRequestHeader "Host", ****SENSITIVE***
        .setRequestHeader "Connection", "keep-alive"
        .setRequestHeader "Content-Length", "207"
        .setRequestHeader "Cache-Control", "max-age=0"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
        .setRequestHeader "Origin", ****SENSITIVE***
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/35.0.1916.114 Safari/537.36"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .setRequestHeader "Referer", ****SENSITIVE***
        .setRequestHeader "Accept-Encoding", "gzip,deflate,sdch"
        .setRequestHeader "Accept-Language", "en-GB,en-US;q=0.8,en;q=0.6"
        .setRequestHeader "Cookie", "JSESSIONID=****SENSITIVE***; ssoLang=en"
        .send (Escape(request))
        While .readyState <> 4: DoEvents: Wend
        If .Status = 200 Then
            Debug.Print .getAllResponseHeaders
            fileNum = FreeFile
            Open localFile For Binary Access Write As #fileNum
            bytes = .responseBody
            Put #fileNum, , bytes
            Close #fileNum
        Else
            MsgBox "XMLhttp POST error " & .statusText & vbCrLf & "Status = " & .Status & vbCrLf & "URL = " & URL
        End If
    End With
End Sub


Private Function Escape(ByVal URL As String) As String
    'URLs cannot contain most special characters.
    'VBScript and JavaScript have built-in Escape functions. In VB we have to write our own
    Dim i As Integer, BadChars As String
    BadChars = "<>%=&!@#£$^()+{[}]|\;:'"",/?"
    For i = 1 To Len(BadChars)
        URL = Replace(URL, Mid(BadChars, i, 1), "%" & Hex(Asc(Mid(BadChars, i, 1))))
    Next i
    URL = Replace(URL, " ", "+")
    Escape = URL
End Function

for some reason this is not working at all. When I look at the response headers in Chrome I see :

• Content-Disposition:
  filename="***.xlsx"
  
• Content-Type:
  application/vnd.openxmlformats-officedocument.spreadsheetml.sheet
  
• Date:
  Sat, 31 May 2014 14:28:25 GMT
  
• Server:
  Apache-Coyote/1.1
  
• Transfer-Encoding:
  chunked

But what I print out in the above VBA call is :

Cache-Control: no-cache, no-store
Date: Sat, 31 May 2014 14:55:38 GMT
Pragma: no-cache
Transfer-Encoding: chunked
Content-Type: text/html;charset=UTF-8
Expires: Thu, 01 Jan 1970 00:00:00 GMT
Server: Apache-Coyote/1.1


The status of the request is 200 whatever the request I send :/ . Can anybody explain what is wrong with my script???

Many thanks

 

[John_w]

Where are you getting the JSESSIONID value from? You can't just use the same value that your browser used, because your XMLhttp request is a separate session and uses a different value. Send an XMLhttp GET request to the URL, put the response in a HTMLDocument object and extract the JSESSIONID value from the HTMLDocument.cookie property, and use the same JSESSIONID value in the POST request.

Also, there is no need to set the "Content-Length" header as I think XMLhttp automatically sets the correct length.