'References required - tick these in Tools -> References in VBA editor
'Microsoft Internet Controls
'Microsoft HTML Object Library
'Microsoft XML v6.0
Option Explicit
Public Sub IE_XMLhttp_Download_File2()
Dim URL As String
Dim IE As InternetExplorerMedium 'or InternetExplorer
#If VBA7 Then
Dim httpReq As XMLHTTP60
Set httpReq = New XMLHTTP60
#Else
Dim httpReq As XMLHTTP
Set httpReq = New XMLHTTP
#End If
Dim HTMLdoc As HTMLDocument
Dim imgs As IHTMLElementCollection, imgExcel As HTMLImg, i As Long
Dim downloadURL As String
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 InternetExplorerMedium 'or 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
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
'Set the JSESSIONID in the Cookie header
.setRequestHeader "Cookie", JSESSIONID
.send
Debug.Print .Status, .statusText
Debug.Print .getAllResponseHeaders
'Send GET to download the Excel file
.Open "GET", downloadURL, 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)"
'Set the JSESSIONID in the Cookie header
.setRequestHeader "Cookie", JSESSIONID
.send
Debug.Print .Status, .statusText
Debug.Print .getAllResponseHeaders
'If successful, save response bytes in the local file
If .Status = 200 Then
fileNum = FreeFile
Open localFile For Binary Access Write As #fileNum
Buffer = .responseBody
Put #fileNum, , Buffer
Close #fileNum
MsgBox "Downloaded " & localFile
Else
MsgBox "URL = " & downloadURL & vbNewLine & "http request returned status " & .Status & vbNewLine & .statusText
End If
End With
Else
MsgBox "Unable to find IMG tag with title=""Excel Export"""
End If
End Sub