使用Excel自动化IE表单填写及导出文件下载问题

问题核心 #

你当前的矛盾点在于：

• 用CLSID {D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E} 创建的中等完整性IE实例，能正常调用 getElementsByName 操作网页元素，但 Application.SendKeys 无法控制下载对话框（权限隔离导致跨进程指令无法传递）。
• 用 CreateObject("InternetExplorer.Application") 创建的普通IE实例，SendKeys能工作，但 getElementsByName 报错（多为页面DOM权限或加载逻辑问题）。

SendKeys本身稳定性极差，且在权限隔离场景下完全失效，不建议依赖它处理下载对话框，以下是更可靠的解决方案：

方案1：修改IE自动下载设置（最简单） #

通过配置IE安全规则，让目标站点自动保存文件，跳过对话框：

1. 打开IE浏览器，点击「工具」→「Internet选项」。
2. 切换到「安全」标签，将 https://qrwb.ecorp.cat.com 添加到「可信站点」。
3. 点击「自定义级别」，修改以下选项：
   • 「文件下载」：设置为启用
   • 「文件下载自动提示」：设置为禁用
4. 保存设置后，运行代码时点击下载按钮会自动保存到IE默认路径，无需处理对话框。

修改后的简化代码：

Sub GetDataExport()
    Dim ARNUM As String
    Dim x As Integer
    Dim NumRows As Long
    Dim IE As Object
    
    NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
    
    For x = 1 To NumRows
        ARNUM = Range("A" & x)
        
        Set IE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
        IE.Visible = True
        IE.navigate "https://qrwb.ecorp.cat.com/cpi/AnalysisTools/Analysis_Tools.cfm?tool=Arrangement"
        
        ' 优化等待逻辑，确保页面完全加载
        Do While IE.Busy Or IE.readyState <> 4
            Application.Wait DateAdd("s", 0.5, Now)
        Loop
        
        IE.document.getElementsByName("arrangement_no")(0).Value = ARNUM
        IE.document.getElementsByName("Download")(0).Click
        
        ' 根据文件大小调整等待时间，确保下载完成
        Application.Wait DateAdd("s", 3, Now)
        
        IE.Quit
        Set IE = Nothing
    Next x
End Sub

方案2：用Windows API捕获并操作下载对话框（无需修改IE设置） #

如果无法修改IE设置，可通过API查找下载对话框句柄，模拟点击「保存」按钮：

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Const BM_CLICK = &HF5

Sub GetDataExport()
    Dim ARNUM As String
    Dim x As Integer
    Dim NumRows As Long
    Dim IE As Object
    Dim dlDialogHwnd As LongPtr
    Dim saveBtnHwnd As LongPtr
    
    NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
    
    For x = 1 To NumRows
        ARNUM = Range("A" & x)
        
        Set IE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
        IE.Visible = True
        IE.navigate "https://qrwb.ecorp.cat.com/cpi/AnalysisTools/Analysis_Tools.cfm?tool=Arrangement"
        
        Do While IE.Busy Or IE.readyState <> 4
            Application.Wait DateAdd("s", 0.5, Now)
        Loop
        
        IE.document.getElementsByName("arrangement_no")(0).Value = ARNUM
        IE.document.getElementsByName("Download")(0).Click
        
        ' 等待下载对话框弹出（最多等待5秒）
        Dim waitTime As Integer
        waitTime = 0
        Do
            Application.Wait DateAdd("s", 0.5, Now)
            dlDialogHwnd = FindWindow("#32770", "文件下载") ' 需根据系统语言修改对话框标题
            waitTime = waitTime + 1
        Loop Until dlDialogHwnd <> 0 Or waitTime >= 10
        
        If dlDialogHwnd <> 0 Then
            ' 找到「保存」按钮并点击（按钮文本需匹配系统语言）
            saveBtnHwnd = FindWindowEx(dlDialogHwnd, 0, "Button", "&保存")
            If saveBtnHwnd <> 0 Then
                SendMessage saveBtnHwnd, BM_CLICK, 0, 0
            End If
        End If
        
        ' 等待保存完成后关闭IE
        Application.Wait DateAdd("s", 2, Now)
        IE.Quit
        Set IE = Nothing
    Next x
End Sub

注意：若为英文系统，需将对话框标题改为「File Download」，按钮文本改为「&Save」。

方案3：直接捕获下载URL，绕过IE下载对话框（最稳定） #

通过浏览器开发者工具（F12）捕获下载按钮对应的请求URL，直接用VBA下载文件，完全无需处理IE：

Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As LongPtr

Const ERROR_SUCCESS = 0

Sub GetDataExport()
    Dim ARNUM As String
    Dim x As Integer
    Dim NumRows As Long
    Dim downloadURL As String
    Dim savePath As String
    Dim result As LongPtr
    
    NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
    savePath = "C:\YourSavePath\" ' 修改为实际保存路径
    
    For x = 1 To NumRows
        ARNUM = Range("A" & x)
        ' 替换为实际捕获的下载URL（需包含arrangement参数）
        downloadURL = "https://qrwb.ecorp.cat.com/cpi/export.cfm?arrangement=" & ARNUM
        
        ' 下载文件
        result = URLDownloadToFile(0, downloadURL, savePath & ARNUM & ".csv", 0, 0)
        If result = ERROR_SUCCESS Then
            Debug.Print ARNUM & " 下载成功"
        Else
            Debug.Print ARNUM & " 下载失败"
        End If
    Next x
End Sub

此方法无需启动IE，效率最高且最稳定，但需准确获取下载请求的URL和参数格式。

内容的提问来源于stack exchange，提问作者Chase Smith