excel - How can I automate Save as dialog box in IE11 using VBA?

Question

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=&registryCode="
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:emp.xml

Set IE = Nothing

Answer 1

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") & "emp.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