关于excel：如何使用VBA在IE11中自动将另存为对话框？


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

我正在尝试下载一些碳排放数据。我可以通过URL向页面预加载相关设置。
它加载正常，我可以按ID单击"确定"按钮，然后在底部获得IE11-"打开/保存/取消对话"。我已经使用FindWindows(#32770)尝试了所有建议，还尝试了"发送密钥"，这是非常不可靠的。有人可以建议使用代码来操纵此对话框，还是可以检查网页上的HTML以查看是否可以直接下载？

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
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
相关讨论

考虑示例：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
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

相关讨论