xmlHttp not returning any content - VBA

Drimacus

New Member
Joined
Dec 12, 2013
Messages
24
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 :

Rich (BB code):
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

MrExcel MVP
Joined
Oct 15, 2007
Messages
5,999
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.
 

Forum statistics

Threads
1,082,271
Messages
5,364,153
Members
400,783
Latest member
sambills

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top