Vba downloadfile

[RFGOES]

Hello, I'm trying to download a file, but I can not. The command can click to download, but I can not automatically save it to the folder I'd like. Could anyone help?


Follow the code:





Sub Update()


Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE


IE.Visible = True
.navigate "http://bvmf.bmfbovespa.com.br/opcoes/opcoes.aspx?idioma=pt-br"


Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop

'Type the date that is in cell A1 in the webpage
IE.Document.forms.Item(0).Item(12).Value = Format(Sheets("SPLAN").Range("A1"), "dd/mm/yyyy")

'Click fetch date to generate the file to download
IE.Document.forms.Item(0).Item(13).Click


'I need to now download the file automatically into my "c: \ mydocuments" folder
'Save file automatically in folder "c: \ mydocuments"




End With
End Sub

 

[John_w]

Hi John, actually this site has 3 options, the one I want is the third option, which puts the date and download the file equal to the code you did earlier that worked perfectly. Option 3 has this link:


Http://bvmf.bmfbovespa.com.br/termo/termo.aspx?idioma=pt
Option 3 "Posicoes Em Aberto"

You've got the wrong URL there; it should be http://bvmf.bmfbovespa.com.br/termo/termo.aspx?idioma=pt-br.

I had a look at the browser requests and it first sends a GET to that URL (the Contratos a Vencer page). When you click the Posições em Aberto link it sends a POST with form data to the same URL. When you click the download link it sends a POST request to the same URL to download the file. See if you can change the code to send a GET followed by 2 POSTs to the URL.

 

[RFGOES]

Hi John, I tried, but my knowledge is very basic and it is not working. I understood perfectly what you said about sending 2 posts, but lack knowledge of how to do this. I researched something about it, but I do not know how.

 

[John_w]

Try this:

Public Sub XMLHttp_Download_Another_File()

    Dim httpReq As Object
    Dim URL As String
    Dim HTMLdoc As Object
    Dim headers As Variant, i As Long, parts As Variant
    Dim cookie As String
    Dim formData As String
    Dim downloadFolder As String, localFile As String
    Dim fileNum As Integer, fileBytes() As Byte
    Dim answer As Variant
    Dim downloadDate As Date
    
    'The required download date
    
    downloadDate = DateValue("30/3/2017")
    
    'Folder in which the downloaded file will be saved
    
    downloadFolder = ThisWorkbook.Path  'same as this workbook
    If Right(downloadFolder, 1) <> "\" Then downloadFolder = downloadFolder & "\"
    
    URL = "http://bvmf.bmfbovespa.com.br/termo/termo.aspx?idioma=pt-br"
    
    Set httpReq = CreateObject("MSXML2.XMLHTTP")
    
    'Send GET to request initial web page "Contratos a Vencer"
        
    With httpReq
        .Open "GET", URL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:52.0) Gecko/20100101 Firefox/52.0"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
        .send   
        headers = Split(.getAllResponseHeaders, vbCrLf)
        
        'Put response in HTMLDocument to extract hidden input elements (__EVENTTARGET, __EVENTARGUMENT, __EVENTVALIDATION, __LASTFOCUS, __VIEWSTATE)
        
        Set HTMLdoc = CreateObject("HTMLfile")
        HTMLdoc.body.innerHTML = .responseText
    End With
    
    'Extract cookie from Set-Cookie headers
    
    cookie = ""
    For i = 0 To UBound(headers)
        parts = Split(headers(i), "Set-Cookie: ")
        If UBound(parts) > 0 Then
            cookie = cookie & Left(parts(1), InStr(parts(1), ";")) & " "
        End If
    Next
    
    'Form data sent by browser when "Posições em Aberto" link is clicked
    
    '__EVENTTARGET:"ctl00$contentPlaceHolderConteudo$tabTermo"
    '__EVENTARGUMENT:"ctl00$contentPlaceHolderConteudo$tabTermo$tabPosicoesEmAberto"
    '__VIEWSTATE:"/wEPDwUA ...very long string... 7uFH+JRQ="
    '__EVENTVALIDATION:"/wEWAgKSgebuAQK0s+TyDrpdnXZ2ZV7Ci665Y+E/B2jFhqE1"
    'ctl00$contentPlaceHolderConteudo$tabTermo:"{"State":{"SelectedIndex":2},"TabState":{"ctl00_contentPlaceHolderConteudo_tabTermo_tabContratoAVencer":{"Selected":false},"ctl00_contentPlaceHolderConteudo_tabTermo_tabPosicoesEmAberto":{"Selected":true}}}"
    'ctl00_contentPlaceHolderConteudo_contratosAVencer_grdContratosAVencerPostDataValue:""
    'ctl00$contentPlaceHolderConteudo$mpgPaginas_Selected:"2"
    
    'Build form data string
    
    formData = ""
    formData = formData & Escape("__EVENTTARGET") & "=" & Escape("ctl00$contentPlaceHolderConteudo$tabTermo") & "&"
    formData = formData & Escape("__EVENTARGUMENT") & "=" & Escape("ctl00$contentPlaceHolderConteudo$tabTermo$tabPosicoesEmAberto") & "&"
    formData = formData & Escape("__VIEWSTATE") & "=" & Escape(HTMLdoc.getElementById("__VIEWSTATE").Value) & "&"
    formData = formData & Escape("__EVENTVALIDATION") & "=" & Escape(HTMLdoc.getElementById("__EVENTVALIDATION").Value) & "&"
    formData = formData & Escape("ctl00$contentPlaceHolderConteudo$tabTermo") & "=" & Escape("{""State"":{""SelectedIndex"":2},""TabState"":{""ctl00_contentPlaceHolderConteudo_tabTermo_tabContratoAVencer"":{""Selected"":false},""ctl00_contentPlaceHolderConteudo_tabTermo_tabPosicoesEmAberto"":{""Selected"":true}}}") & "&"
    formData = formData & Escape("ctl00_contentPlaceHolderConteudo_contratosAVencer_grdContratosAVencerPostDataValue") & "=&"
    formData = formData & Escape("ctl00$contentPlaceHolderConteudo$mpgPaginas_Selected") & "=2"
    
    'Send form data in POST to request "Posições em Aberto" page
    
    With httpReq
        .Open "POST", URL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:52.0) Gecko/20100101 Firefox/52.0"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
        .setRequestHeader "Set-Cookie", cookie
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send (formData)        'brackets are compulsory only for late binding of XMLhttp
    
        'Put response in HTMLDocument to extract hidden input elements (__EVENTTARGET, __EVENTARGUMENT, __EVENTVALIDATION, __LASTFOCUS, __VIEWSTATE)
        
        Set HTMLdoc = CreateObject("HTMLfile")
        HTMLdoc.body.innerHTML = .responseText
    End With
    
    'Form data sent by browser when Download link is clicked
    
    '__EVENTTARGET:""
    '__EVENTARGUMENT:""
    '__VIEWSTATE:"/wEPDwUA ...very long string... 7uFH+JRQ="
    '__EVENTVALIDATION:"/wEWAgKSgebuAQK0s+TyDrpdnXZ2ZV7Ci665Y+E/B2jFhqE1"
    'ctl00$contentPlaceHolderConteudo$tabTermo:"{"State":{},"TabState":{"ctl00_contentPlaceHolderConteudo_tabTermo_tabPosicoesEmAberto":{"Selected":true}}}"
    'ctl00$contentPlaceHolderConteudo$posicoesEmAberto$txtConsultaData:"30/03/2017"
    'ctl00$contentPlaceHolderConteudo$posicoesEmAberto$txtConsultaEmpresa:""
    'ctl00$contentPlaceHolderConteudo$posicoesEmAberto$txtConsultaDataDownload:"30/03/2017"
    'ctl00$contentPlaceHolderConteudo$posicoesEmAberto$btnBuscarArquivos:"Buscar"
    'ctl00$contentPlaceHolderConteudo$mpgPaginas_Selected:"2"
    
    'Build form data string
    
    formData = ""
    formData = formData & Escape("__EVENTTARGET") & "=" & Escape(HTMLdoc.getElementById("__EVENTTARGET").Value) & "&"
    formData = formData & Escape("__EVENTARGUMENT") & "=" & Escape(HTMLdoc.getElementById("__EVENTARGUMENT").Value) & "&"
    formData = formData & Escape("__VIEWSTATE") & "=" & Escape(HTMLdoc.getElementById("__VIEWSTATE").Value) & "&"
    formData = formData & Escape("__EVENTVALIDATION") & "=" & Escape(HTMLdoc.getElementById("__EVENTVALIDATION").Value) & "&"
    formData = formData & Escape("ctl00$contentPlaceHolderConteudo$tabTermo") & "=" & Escape("{""State"":{},""TabState"":{""ctl00_contentPlaceHolderConteudo_tabTermo_tabPosicoesEmAberto"":{""Selected"":true}}}") & "&"
    formData = formData & Escape("ctl00$contentPlaceHolderConteudo$posicoesEmAberto$txtConsultaData") & "=" & Escape(Format(downloadDate, "dd/mm/yyyy")) & "&"
    formData = formData & Escape("ctl00$contentPlaceHolderConteudo$posicoesEmAberto$txtConsultaEmpresa") & "=&"
    formData = formData & Escape("ctl00$contentPlaceHolderConteudo$posicoesEmAberto$txtConsultaDataDownload") & "=" & Escape(Format(downloadDate, "dd/mm/yyyy")) & "&"
    formData = formData & Escape("ctl00$contentPlaceHolderConteudo$posicoesEmAberto$btnBuscarArquivos") & "=Buscar&"
    formData = formData & Escape("ctl00$contentPlaceHolderConteudo$mpgPaginas_Selected") & "=2"
   
    'Send form data in POST to request the file download
    
    With httpReq
        .Open "POST", URL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:52.0) Gecko/20100101 Firefox/52.0"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
        .setRequestHeader "Set-Cookie", cookie
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send (formData)        'brackets are compulsory only for late binding of XMLhttp
        
        'Get download filename from Content-Disposition header
        
        localFile = Split(.getResponseHeader("Content-Disposition"), "filename=")(1)
        localFile = downloadFolder & Replace(localFile, Chr(34), "")
        
        'Save response in the local file
        
        If .Status = 200 Then
            If Dir(localFile) <> "" Then Kill localFile
            fileBytes = .responseBody
            fileNum = FreeFile
            Open localFile For Binary Access Write As #fileNum
            Put #fileNum, 1, fileBytes
            Close #fileNum
            
            answer = MsgBox(localFile & vbCrLf & _
                          "Bytes downloaded = " & UBound(fileBytes) + 1 & vbCrLf & _
                          "Open file?", vbYesNo)
            If answer = vbYes Then Shell "notepad " & localFile
        Else
            MsgBox "Response status: " & .Status & " - " & .statusText
        End If
        
    End With
    
End Sub


'http://www.tushar-mehta.com/publish_train/xl_vba_cases/vba_web_pages_services/
'With bug fix.  The "%" should be first in the BadChars string because it is used as the escape character.

Private Function Escape(ByVal param As String) As String

    Dim i As Integer, BadChars As String

    BadChars = "%<>=&!@#$^()+{[}]|\;:'"",/?"
    For i = 1 To Len(BadChars)
        param = Replace(param, Mid(BadChars, i, 1), "%" & Hex(Asc(Mid(BadChars, i, 1))))
    Next
    param = Replace(param, " ", "+")
    Escape = param

End Function

 

[RFGOES]

Hi John, I was doing almost right, now I understood where I was wrong. Thank you very much for all your help.

 

[RFGOES]

I just forgot to ask, is there any way to see this code running visibly? Type one visible = true ?? I wanted to study it more.

 

[John_w]

By using XMLhttp requests, the code is designed to run without anything being displayed to the user. If you want to learn how the code works then use normal VBA debugging methods:

1. Step through the lines by pressing the F8 key in the VBA editor. Examine variables in the Locals window.

2. Add Debug.Print statements to the code which will output variables to the Immediate Window, for example:

       Debug.Print .getAllResponseHeaders
       headers = Split(.getAllResponseHeaders, vbCrLf)

3. Examine variables by typing ?variableName <return>in the Immediate Window, for example:

?cookie

</return>