如何使用 VBA 在 IE11 中自动保存另存为对话框？

Question

我正在尝试下载一些有关碳排放的数据。我可以通过 URL 预加载具有相关设置的页面。 它加载得很好，我可以通过它的 ID 单击 OK 按钮，然后我在底部看到 IE11 - Open/Save/Cancel Dialogue。我已经使用 FindWindows (#32770) 尝试了所有建议，还尝试了非常不可靠的 Send Keys。有人可以建议操作此对话框的代码，或者检查网页上的 HTML 以查看是否可以直接下载？

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:\temp.xml

Set IE = Nothing

Answer 1

考虑这个例子：

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