Excel VBA实现IE11下载自动另存为及Busy方法报错求助

咱们先从你遇到的两个问题逐个解决——先搞定ieApp.Busy的运行时错误，再实现自动保存功能。

问题1：修复Method 'Busy' of object 'IWebBrowser2' failed错误 #

你代码里的While ieApp.Busy Or ieApp.ReadyState <> 45是核心问题：

• IE的ReadyState属性值中，加载完成的状态是4（对应READYSTATE_COMPLETE），你写的45是完全错误的，导致循环无限等待，最终触发Busy属性的异常。
• 另外，Busy属性在IE某些状态下可能会抛出错误，所以需要加错误处理来避免崩溃。

修正后的等待加载代码段：

Do
    DoEvents
    ' 临时捕获错误，防止Busy属性调用失败
    On Error Resume Next
    Dim isBusy As Boolean
    isBusy = ieApp.Busy
    Dim readyState As Integer
    readyState = ieApp.ReadyState
    On Error GoTo 0
Loop While isBusy Or readyState <> 4

问题2：实现自动“另存为”功能 #

之前你尝试的FindWindowEx没生效，是因为IE下载对话框的层级和窗口类名需要精准匹配，而且要处理“下载列表”和“另存为”两个对话框的先后逻辑。我们需要借助Windows API来控制这些系统级窗口。

第一步：添加API声明 #

在VBA模块的最顶部添加以下API声明（兼容32位和64位Office）：

#If VBA7 Then
    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
    Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
#Else
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
#End If

Const BM_CLICK = &HF5
Const WM_SETTEXT = &HC

第二步：完整的自动下载代码 #

把以下代码替换你原来的代码，它会自动处理下载对话框并完成保存：

Sub AutoDownloadWeatherData()
    Dim Filename As String
    Dim ieApp As Object
    Dim URL As String
    Dim ieHWND As LongPtr
    Dim downloadDialogHWND As LongPtr
    Dim saveButtonHWND As LongPtr
    Dim saveAsDialogHWND As LongPtr
    Dim editBoxHWND As LongPtr
    
    ' 获取配置的URL和保存路径
    URL = Range("All_Quad_URL").Value
    Filename = "C:\Historic_Weather_Data\Precipitation" & Range("File_Name").Value
    
    ' 确保目标文件夹存在（如果不存在就创建）
    If Dir("C:\Historic_Weather_Data", vbDirectory) = "" Then
        MkDir "C:\Historic_Weather_Data"
    End If
    
    ' 初始化IE并导航
    Set ieApp = CreateObject("InternetExplorer.Application")
    ieApp.Visible = True
    ieApp.Navigate URL
    
    ' 等待IE加载完成（修正后的逻辑）
    Do
        DoEvents
        On Error Resume Next
        Dim isBusy As Boolean
        isBusy = ieApp.Busy
        Dim readyState As Integer
        readyState = ieApp.ReadyState
        On Error GoTo 0
    Loop While isBusy Or readyState <> 4
    
    ' 等待下载对话框弹出（可根据实际情况调整等待时长）
    Application.Wait Now + TimeValue("00:00:03")
    
    ' 查找"View Downloads - Internet Explorer"对话框
    downloadDialogHWND = FindWindow(vbNullString, "View Downloads - Internet Explorer")
    
    If downloadDialogHWND <> 0 Then
        ' 查找"保存"按钮（兼容中英文系统）
        saveButtonHWND = FindWindowEx(downloadDialogHWND, 0, "Button", "保存")
        If saveButtonHWND = 0 Then saveButtonHWND = FindWindowEx(downloadDialogHWND, 0, "Button", "Save")
        
        If saveButtonHWND <> 0 Then
            ' 点击保存按钮
            SetForegroundWindow downloadDialogHWND
            SendMessage saveButtonHWND, BM_CLICK, 0, 0
            
            ' 等待"另存为"对话框弹出
            Application.Wait Now + TimeValue("00:00:02")
            
            ' 查找"另存为"对话框（兼容中英文）
            saveAsDialogHWND = FindWindow("#32770", "另存为")
            If saveAsDialogHWND = 0 Then saveAsDialogHWND = FindWindow("#32770", "Save As")
            
            If saveAsDialogHWND <> 0 Then
                ' 查找文件名输入框
                editBoxHWND = FindWindowEx(saveAsDialogHWND, 0, "Edit", vbNullString)
                
                If editBoxHWND <> 0 Then
                    ' 设置目标文件名
                    SetForegroundWindow saveAsDialogHWND
                    SendMessage editBoxHWND, WM_SETTEXT, 0, ByVal Filename
                    
                    ' 点击"保存"按钮完成操作
                    Dim finalSaveBtn As LongPtr
                    finalSaveBtn = FindWindowEx(saveAsDialogHWND, 0, "Button", "保存")
                    If finalSaveBtn = 0 Then finalSaveBtn = FindWindowEx(saveAsDialogHWND, 0, "Button", "Save")
                    
                    If finalSaveBtn <> 0 Then
                        SendMessage finalSaveBtn, BM_CLICK, 0, 0
                    Else
                        MsgBox "找不到另存为对话框的保存按钮！"
                    End If
                Else
                    MsgBox "找不到文件名输入框！"
                End If
            Else
                MsgBox "找不到另存为对话框！"
            End If
        Else
            MsgBox "找不到下载对话框的保存按钮！"
        End If
    Else
        MsgBox "找不到下载对话框！"
    End If
    
    ' 关闭IE并释放资源
    ieApp.Quit
    Set ieApp = Nothing
End Sub

关键注意事项 #

• 窗口标题兼容：如果你的系统是英文，按钮和对话框标题是英文；中文系统则是中文，代码已经做了兼容。如果还是找不到窗口，可以用Spy++工具查看实际的窗口标题和类名。
• 等待时长调整：Application.Wait的时间可以根据你的网络速度和页面加载速度调整，避免等待不足导致找不到窗口。
• 文件夹存在性：代码里加了自动创建目标文件夹的逻辑，防止因为文件夹不存在导致保存失败。

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