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

Question

我想下载一些关于碳排放的数据。我可以通过URL预载相关设置的页面。 它加载正常，我可以点击确定按钮的ID，然后我得到IE11 - 打开/保存/取消对话在底部。我已经使用FindWindows（＃32770）尝试了所有建议，并发送了非常不可靠的密钥。有人可以建议操纵这个对话框的代码，或者也许可以检查网页上的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