Excel VBA：移除固定等待自动检测下载栏+直接定位指定图片点击

针对需求完成以下两处核心优化：

• 移除固定时长等待，实现下载栏的自动检测
• 直接定位目标图片元素，无需遍历所有图片

修改后的完整代码 #

Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
    ByVal hwndParent As Long, _
    ByVal hwndChildAfter As Long, _
    ByVal lpszClass As String, _
    ByVal lpszWindow As String) As Long

Sub Test()
    Const cURL = "https://mywebsite"
    Const cUsername = "xxxxxx"    '替换为你的用户名
    Const cPassword = "xxxxxxxxxxx"    '替换为你的密码
    
    Dim ie As InternetExplorerMedium
    Dim doc As HTMLDocument
    Dim LoginForm As HTMLFormElement
    Dim CIFs As MSHTML.HTMLWindow2
    Dim UserNameInputBox As HTMLInputElement
    Dim PasswordInputBox As HTMLInputElement
    Dim SignInButton As HTMLInputButtonElement
    Dim targetImg As MSHTML.HTMLImg
    Dim timeout As Date
    
    Set ie = New InternetExplorerMedium
    With ie
        ie.Visible = True
        ie.navigate cURL
    
        '等待页面加载完成
        Do While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy: DoEvents: Loop
        Set doc = ie.document
    
        On Error Resume Next
        doc.getElementsByName("overridelink").Item.Click
        Application.Wait (Now + TimeValue("0:00:03"))
        On Error GoTo 0
    
        '登录流程
        Set LoginForm = doc.forms(0)
        Set UserNameInputBox = LoginForm.elements("j_username")
        UserNameInputBox.Value = cUsername
        
        Set PasswordInputBox = LoginForm.elements("j_Password")
        PasswordInputBox.Value = cPassword
        
        Set SignInButton = LoginForm.elements("btn_login")
        SignInButton.Click
            
        '等待登录后页面加载
        Do While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy: DoEvents: Loop
   
        ie.navigate "https:/mywebsite2"
        Do While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy: DoEvents: Loop
        
        Set doc = ie.document
        Set CIFs = doc.frames(0)
        CIFs.document.getElementById("_paramsCIF_NO").Value = Range("A3")
  
        '优化点1：直接通过属性选择器定位目标图片，无需遍历
        On Error Resume Next
        Set targetImg = CIFs.document.querySelector("img[src='/xmlpserver/theme/al_excel.gif']")
        On Error GoTo 0
        
        If Not targetImg Is Nothing Then
            targetImg.Click
        Else
            MsgBox "未找到目标下载图片"
            Exit Sub
        End If
        
        '优化点2：循环检测下载栏，替代固定时长等待
        timeout = Now + TimeValue("00:02:00") '设置2分钟超时
        Do Until AutoSave() Or Now > timeout
            DoEvents
        Loop
        
        If Now > timeout Then
            MsgBox "等待下载栏超时"
        Else
            MsgBox "操作完成"
        End If
    End With
    
    '清理对象
    Set ie = Nothing
    Set doc = Nothing
    Set CIFs = Nothing
End Sub

Public Function AutoSave() As Boolean
    On Error GoTo handler
    Dim sysAuto As New UIAutomationClient.CUIAutomation
    Dim ieWindow As UIAutomationClient.IUIAutomationElement
    Dim cond As IUIAutomationCondition
    Dim tField As UIAutomationClient.IUIAutomationElement
    Dim tFieldCond As IUIAutomationCondition
    Dim invPattern As UIAutomationClient.IUIAutomationInvokePattern
    
    '构建下载栏的查找条件
    Set cond = sysAuto.CreateAndCondition( _
        sysAuto.CreatePropertyCondition(UIA_NamePropertyId, "Notification"), _
        sysAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ToolBarControlTypeId))
    Set ieWindow = sysAuto.GetRootElement.FindFirst(TreeScope_Descendants, cond)
    
    If ieWindow Is Nothing Then
        AutoSave = False
        Exit Function
    End If
    
    '查找下载栏中的保存按钮
    Set tFieldCond = sysAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_SplitButtonControlTypeId)
    Set tField = ieWindow.FindFirst(TreeScope_Descendants, tFieldCond)
    
    If tField Is Nothing Then
        AutoSave = False
        Exit Function
    End If
    
    '触发保存操作
    Set invPattern = tField.GetCurrentPattern(UIA_InvokePatternId)
    invPattern.Invoke
    AutoSave = True
    Exit Function
    
handler:
    AutoSave = False
End Function

关键修改说明 #

1. 直接定位目标图片：
   使用querySelector方法结合属性选择器img[src='/xmlpserver/theme/al_excel.gif']，直接匹配src属性符合要求的图片元素，省去遍历所有图片的冗余操作，执行效率更高。

2. 替换固定等待为动态检测：

   • 移除了Application.Wait (Now + TimeValue("0:00:20"))固定等待语句
   • 新增2分钟超时机制，循环调用AutoSave函数，直到函数返回成功（下载栏已找到并触发操作）或超时，避免因网络或系统延迟导致的等待不足或时间浪费
   • 优化AutoSave函数逻辑，增加元素存在性判断，确保只有找到目标元素时才执行操作，返回布尔值告知调用方结果

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