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