'References required - tick these in Tools -> References in VBA editor
'Microsoft Internet Controls
'Microsoft HTML Object Library
'Microsoft WinHTTP Services version 5.1
Public Sub IE_WinHttp_Download_File1()
Dim URL As String
Dim IE As InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim imgs As IHTMLElementCollection, imgExcel As HTMLImg, i As Long
Dim downloadURL As String
Dim httpReq As WinHttpRequest
Set httpReq = New WinHttpRequest
'Dim httpReq As Object
'Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
'#If VBA7 Then
' Dim httpReq As WinHttpRequest60
' Set httpReq = New WinHttpRequest60
'#Else
' Dim httpReq As WinHttpRequest
' Set httpReq = New WinHttpRequest
'#End If
Dim fileNum As Integer, Buffer() As Byte
Dim saveInFolder As String, localFile As String
Dim res As Variant
Dim JSESSIONID As String
'Folder in which the downloaded file will be saved
saveInFolder = ThisWorkbook.Path
If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"
localFile = saveInFolder & "Excel workbook.xls"
URL = "https://www.YourIntranetSite.com" 'CHANGE THIS TO THE CORRECT URL
With httpReq
'Send GET to the home page and extract the JSESSIONID from the "Set-Cookie" response header
'JSESSIONID=5913D49F2E35EA9D0xxxxx.nuxxx; org.xxx.seam.core.Locale=en_US
.Open "GET", URL, False
.send
Debug.Print .Status, .statusText
Debug.Print .getAllResponseHeaders
JSESSIONID = Split(.getResponseHeader("Set-Cookie"), ";")(0)
End With
Set IE = New InternetExplorer
With IE
.navigate URL
.Visible = True
While .readyState <> READYSTATE_COMPLETE
DoEvents
Wend
AppActivate Application.Caption
res = MsgBox("Navigate to the web page containing the Excel Export link, logging in if necessary." & vbNewLine & _
"Then click OK to continue and download the file, or click Cancel to quit.", vbOKCancel)
If res = vbCancel Then Exit Sub
Set HTMLdoc = .document
End With
'Find the "Excel Export" img tag
Set imgs = HTMLdoc.getElementsByTagName("IMG")
i = 0
Set imgExcel = Nothing
While i < imgs.Length And imgExcel Is Nothing
If imgs(i).Title = "Excel Export" Then Set imgExcel = imgs(i)
i = i + 1
Wend
If Not imgExcel Is Nothing Then
downloadURL = imgExcel.parentElement.href
Set httpReq = New WinHttpRequest
With httpReq
'Send GET to request same page as current IE page (might not need this)
'.Open "GET", IE.LocationURL, False
'.setRequestHeader "Accept", "application/x-ms-application, image/jpeg, application/xaml+xml, image/xxxf, image/pjpeg, application/x-ms-xbap, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*"
'.setRequestHeader "Accept-Language", "fr-CA"
'.setRequestHeader "Accept-Encoding", "gzip, deflate"
'.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.1; WOW64; Trident/7.0; SLCC2; .NET CLR 2.0.50727; .NET CLR 3.5.30729; .NET CLR 3.0.30729; Media Center PC 6.0)"
'.setRequestHeader "Referer", IE.LocationURL
.send
'Send GET to request the Excel file
.Open "GET", downloadURL, False
'Disable automatic http redirect, so we can extract the redirect URL from the response
.Option(WinHttpRequestOption_EnableRedirects) = False
'.setRequestHeader "Accept", "application/x-ms-application, image/jpeg, application/xaml+xml, image/xxxf, image/pjpeg, application/x-ms-xbap, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*"
'.setRequestHeader "Accept-Language", "fr-CA"
'.setRequestHeader "Accept-Encoding", "gzip, deflate"
'.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.1; WOW64; Trident/7.0; SLCC2; .NET CLR 2.0.50727; .NET CLR 3.5.30729; .NET CLR 3.0.30729; Media Center PC 6.0)"
'.setRequestHeader "", "" 'other header?
.send
If .Status = 302 Then
'Get the redirect URL from the Location header
downloadURL = .getResponseHeader("Location")
'Send GET to (hopefully) download the Excel file
.Open "GET", downloadURL
.send
'If successful, save response in the local file
If .Status = 200 Then
fileNum = FreeFile
Open localFile For Binary Access Write As #fileNum
Buffer = .responseBody
Put #fileNum, 1, Buffer
Close #fileNum
MsgBox "Downloaded " & localFile
Else
MsgBox "URL = " & downloadURL & vbNewLine & "http request returned status " & .Status & vbNewLine & .statusText
End If
Else
'Not the expected 302 response
MsgBox "URL = " & downloadURL & vbNewLine & "Expected response = 302" & vbNewLine & "Actual response = " & .Status & vbNewLine & .statusText
End If
End With
Else
MsgBox "Unable to find IMG tag with title=""Excel Export"""
End If
End Sub
