Download File from Website from Excel

[FellowExcellor]

Anyone know how to download a data file from a website without an API?

For example I can download the following file in csv or excel format by clicking on the download button but if I wanted to do it using a macro from Excel how could I do it?

https://fred.stlouisfed.org/series/DGS20

Thanks

Excellor

 

[John_w]

This is quite an unusual solution because it combines IE automation and a http GET request.

Public Sub Download_Excel_File()

    Dim URL As String
    Dim IE As Object
    Dim HTMLdoc As Object
    Dim downloadLink As Object
    Dim httpReq As Object
    Dim downloadURL As String
    Dim downloadFolder As String, localFile As String
    Dim downloadFileName As String
    Dim fileNum As Integer, fileBytes() As Byte
    
    'Folder in which the downloaded file will be saved
    
    downloadFolder = ThisWorkbook.Path
    If Right(downloadFolder, 1) <> "\" Then downloadFolder = downloadFolder & "\"
    
    URL = "https://fred.stlouisfed.org/series/DGS20"
    
    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = True
        .navigate URL
        While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
        Set HTMLdoc = .document
    End With

    'Click the Download Excel link.  This updates the href with the URL of the file
    
    Set downloadLink = HTMLdoc.getElementById("download-data")
    downloadLink.Click
    downloadURL = downloadLink.href
    
    'Quit IE to cancel the IE download
    
    IE.Quit
    Set IE = Nothing
    
    'Sent http GET to download the file
    
    Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    With httpReq
        .Open "GET", downloadURL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:50.0) Gecko/20100101 Firefox/50.0"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
        .setRequestHeader "Accept-Language", "en-US,en;q=0.5"
        .setRequestHeader "Referer", URL
        .setRequestHeader "Upgrade-Insecure-Requests", "1"
        .send
        
        If .Status = 200 Then
        
            downloadFileName = .GetResponseHeader("Content-Disposition")
            downloadFileName = Split(downloadFileName, "filename=")(1)
            downloadFileName = Replace(downloadFileName, Chr(34), "")
            
            localFile = downloadFolder & downloadFileName
                
            'Save response in the local file
        
            If Dir(localFile) <> "" Then Kill localFile
            fileBytes = .ResponseBody
            fileNum = FreeFile
            Open localFile For Binary Access Write As #fileNum
            Put #fileNum, 1, fileBytes
            Close #fileNum
            If MsgBox("Open the downloaded file " & localFile & " ?", vbYesNo) = vbYes Then
                Workbooks.Open localFile
            End If
            
        Else
        
            MsgBox "http GET request to " & downloadURL & vbCrLf & vbCrLf & "returned status " & .Status & " (" & .StatusText & ")"
        
        End If
        
    End With
    
End Sub

 

[FellowExcellor]

This is quite an unusual solution because it combines IE automation and a http GET request.

Public Sub Download_Excel_File()

    Dim URL As String
    Dim IE As Object
    Dim HTMLdoc As Object
    Dim downloadLink As Object
    Dim httpReq As Object
    Dim downloadURL As String
    Dim downloadFolder As String, localFile As String
    Dim downloadFileName As String
    Dim fileNum As Integer, fileBytes() As Byte
    
    'Folder in which the downloaded file will be saved
    
    downloadFolder = ThisWorkbook.Path
    If Right(downloadFolder, 1) <> "\" Then downloadFolder = downloadFolder & "\"
    
    URL = "https://fred.stlouisfed.org/series/DGS20"
    
    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = True
        .navigate URL
        While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
        Set HTMLdoc = .document
    End With

    'Click the Download Excel link.  This updates the href with the URL of the file
    
    Set downloadLink = HTMLdoc.getElementById("download-data")
    downloadLink.Click
    downloadURL = downloadLink.href
    
    'Quit IE to cancel the IE download
    
    IE.Quit
    Set IE = Nothing
    
    'Sent http GET to download the file
    
    Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    With httpReq
        .Open "GET", downloadURL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:50.0) Gecko/20100101 Firefox/50.0"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
        .setRequestHeader "Accept-Language", "en-US,en;q=0.5"
        .setRequestHeader "Referer", URL
        .setRequestHeader "Upgrade-Insecure-Requests", "1"
        .send
        
        If .Status = 200 Then
        
            downloadFileName = .GetResponseHeader("Content-Disposition")
            downloadFileName = Split(downloadFileName, "filename=")(1)
            downloadFileName = Replace(downloadFileName, Chr(34), "")
            
            localFile = downloadFolder & downloadFileName
                
            'Save response in the local file
        
            If Dir(localFile) <> "" Then Kill localFile
            fileBytes = .ResponseBody
            fileNum = FreeFile
            Open localFile For Binary Access Write As #fileNum
            Put #fileNum, 1, fileBytes
            Close #fileNum
            If MsgBox("Open the downloaded file " & localFile & " ?", vbYesNo) = vbYes Then
                Workbooks.Open localFile
            End If
            
        Else
        
            MsgBox "http GET request to " & downloadURL & vbCrLf & vbCrLf & "returned status " & .Status & " (" & .StatusText & ")"
        
        End If
        
    End With
    
End Sub

Thanks.

I've test this and it works great. But didn't realise it would require so much code!

Thanks,

FE

 

[Ombir]

Here is another way that require reference to UI automation library.

Before running this code, copy the file "C:\Windows\System32\UIAutomationCore.dll" file to another location. For Ex: C:\TestFolder\UIAutomationCore.dll then add reference to this dll file from VBE-->Tools--->References----->Browse

You also need to add the reference to Microsoft HTML object library and Microsoft Internet Controls from VBE-->Tools--->References.

Private  Declare PtrSafe Function FindWindowEx Lib "user32" Alias  "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal  lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Dim ie As InternetExplorer
Sub Ombir_25Dec2016()
Dim Doc         As HTMLDocument
Dim Download    As Object

Set ie = New InternetExplorer

With ie
    .Visible = True
    .Navigate "https://fred.stlouisfed.org/series/DGS20"
    Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
End With

Set Doc = ie.Document
Doc.getElementById("download-data").Click
Call Click
ie.Quit
End Sub
Sub Click()
    Dim iehandle        As LongPtr
    Dim uiauto          As IUIAutomation
    Dim ele             As IUIAutomationElement
    Dim Button          As IUIAutomationElement
    Dim Cnd             As IUIAutomationCondition
    Dim InvokePattern   As IUIAutomationInvokePattern
    
    Set uiauto = New CUIAutomation
    iehandle = ie.hwnd
    
    Do While iehandle = 0
        iehandle = FindWindowEx(iehandle, 0, "Frame Notification Bar", vbNullString)
    Loop
    
    Set ele = uiauto.ElementFromHandle(ByVal iehandle)

    Do While Button Is Nothing
        Set Cnd = uiauto.CreatePropertyCondition(UIA_NamePropertyId, "Save")
        Set Button = ele.FindFirst(TreeScope_Subtree, Cnd)
    Loop

    Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke
End Sub