I am trying to download some data on carbon emissions. I can preload the page with the relevant settings via the URL. It loads fine and I can click the OK button by its ID then I get the IE11 - Open/Save/Cancel Dialogue at the bottom. I have tried all suggestions using FindWindows (#32770) and also Send Keys which is very unreliable. Can someone suggest the code to manipulate this dialogue box or else perhaps examine the HTML on the web page to see if a direct download would be possible?
Dim htm As Object
Dim IE As Object
Dim Doc As Object
Set IE = CreateObject("internetexplorer.application")
IE.Visible = True
IE.Navigate "http://ec.europa.eu/environment/ets/exportEntry.do?form=accountAll&permitIdentifier=&accountID=&installationIdentifier=&complianceStatus=&account.registryCodes=CY&primaryAuthRep=&searchType=account&identifierInReg=&mainActivityType=&buttonAction=&account.registryCode=&languageCode=en&installationName=&accountHolder=&accountStatus=&accountType=&action=®istryCode="
Do While IE.readystate <> 4: DoEvents: Loop
Set Doc = CreateObject("htmlfile")
Set Doc = IE.document
Doc.getelementbyID("btnOK").Click [embed=file 884739]
'I need code here which clicks the save as button as save the file as C:\temp.xml
Set IE = Nothing
Consider the example:
Option Explicit
Sub Test()
Dim strExportURL As String
Dim strFormData As Variant
Dim strContent As String
Dim arrRespBody() As Byte
' build exportURL parameter
strExportURL = Join(Array( _
"permitIdentifier=", _
"accountID=", _
"form=accountAll", _
"installationIdentifier=", _
"complianceStatus=", _
"account.registryCodes=CY", _
"primaryAuthRep=", _
"searchType=account", _
"identifierInReg=", _
"mainActivityType=", _
"buttonAction=", _
"account.registryCode=", _
"languageCode=en", _
"installationName=", _
"accountHolder=", _
"accountStatus=", _
"accountType=", _
"action=", _
"registryCode=" _
), "&")
' build the whole form data
strFormData = Join(Array( _
"languageCode=en", _
"exportURL=" & EncodeUriComponent(strExportURL), _
"form=accountAll", _
"exportType=1", _
"OK=Ok" _
), "&")
' POST XHR to retrieve the content
With CreateObject("Microsoft.XMLHTTP")
.Open "POST", "http://ec.europa.eu/environment/ets/export.do", False
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send strFormData
arrRespBody = .ResponseBody
' strRespText = .ResponseText
' strRespHeaders = .GetAllResponseHeaders
' strStatus = .Status
End With
' some processing examples
' convert to string
strContent = BinaryToText(arrRespBody, "utf-8")
' replace LF symbols with CRLF for line breaks to be displayed right
strContent = Replace(strContent, vbLf, vbCrLf)
' show in notepad
ShowInNotepad strContent
' save to temp.xml file on the desktop folder
SaveBinaryToFile arrRespBody, CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & "\temp.xml"
End Sub
Function EncodeUriComponent(sText)
With CreateObject("ScriptControl")
.Language = "JScript"
EncodeUriComponent = .Run("encodeURIComponent", sText)
End With
End Function
Sub ShowInNotepad(strToFile)
Dim strTempPath
With CreateObject("Scripting.FileSystemObject")
strTempPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%TEMP%") & "\" & .GetTempName
With .CreateTextFile(strTempPath, True, True)
.WriteLine (strToFile)
.Close
End With
CreateObject("WScript.Shell").Run "notepad.exe " & strTempPath, 1, True
.DeleteFile (strTempPath)
End With
End Sub
Function BinaryToText(arrBytes() As Byte, strCharSet As String)
With CreateObject("ADODB.Stream")
.Type = 1 ' adTypeBinary
.Open
.Write arrBytes
.Position = 0
.Type = 2 ' adTypeText
.Charset = strCharSet
BinaryToText = .ReadText
.Close
End With
End Function
Sub SaveBinaryToFile(arrBytes() As Byte, strPath As String)
With CreateObject("ADODB.Stream")
.Type = 1 ' adTypeBinary
.Open
.Write arrBytes
.SaveToFile strPath, 2 ' adSaveCreateOverWrite
.Close
End With
End Sub