等待直到出现下载栏,然后继续执行代码

时间:2019-12-01 17:31:57

标签: excel vba web-scraping

我正在尝试自动从网站下载数据。我当前要执行的操作是等到出现如下所示的下载弹出窗口,然后再按alt + S: DownloadPopup 完成此操作后,我希望vba等待下载完成弹出窗口出现后再继续该过程 DownloadCompletePopup

到目前为止,我已经尝试使用下面的代码来尝试识别并等待下载栏,但是即使出现下载栏,FindInitDownloadPopup()和FindDownloadPopup2()都不会退出循环。我看过其他类似的帖子,但是没有提议的解决方案对我有用

Option Explicit

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, 
ByVal lpWindowName As String) As Long

Private 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

Sub FindInitDownloadPopup()
Dim ie As InternetExplorer
Dim h As Long
h = ie.hWnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)

If h = 0 Then
    Do While h = 0
        Application.Wait (Now + TimeValue("00:00:02"))
        h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
    Loop
Else
End If
End Sub

Sub FindDownloadPopup2()
Dim hWnd As Long
Do
    hWnd = FindWindow("#32770", "File Download")
    DoEvents
Loop Until hWnd
End Sub

1 个答案:

答案 0 :(得分:1)

我有类似的问题。我的解决方案是在运行代码之前清除下载文件夹,然后创建一个简单的循环以查找完成的下载。

此处是“单击保存并等待下载”的代码。请注意,我使用Sleep是因为我发现由于内部Intranet的连接问题,我需要等待。另外,我基于ClaimNumber(我在财务部门工作)运行此代码,因此在需要时省略

' Declare Sleep
#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" _
            (ByVal dwMilliseconds As LongPtr)    ' For 64 Bit Systems
#Else
    Public Declare Sub Sleep Lib "kernel32" _
            (ByVal dwMilliseconds As Long)    ' For 32 Bit Systems
#End If

Private Sub ClickSave(ClaimNumber As String)

    Sleep 1000

    Dim o As IUIAutomation
    Set o = New CUIAutomation

    Do
        Dim h As Long
        h = IE.HWND
        h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)

        If h <> 0 Then
            Dim count As Long
            count = 0
            Exit Do
        Else
            Sleep 100
            count = count + 1
            If count = 50 Then Exit Sub
        End If
    Loop

    Dim e As IUIAutomationElement
    Set e = o.ElementFromHandle(ByVal h)

    Dim iCnd As IUIAutomationCondition
    Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")

    Dim Button As IUIAutomationElement
    Set Button = e.FindFirst(TreeScope_Subtree, iCnd)

    Do
        On Error Resume Next
        Dim InvokePattern As IUIAutomationInvokePattern
        Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)

        If Err.Number = 0 Then
            On Error GoTo 0
            Exit Do
        Else
            Sleep 100
            count = count + 1
        End If
        On Error GoTo 0
    Loop Until count = 100

    InvokePattern.Invoke

    Do
        Sleep 1000
        Completed = DownloadComplete(ClaimNumber)
        If Completed = "Yes" Then Exit Do
    Loop

    SendMessage h, WM_CLOSE, 0, 0


End Sub

Private Function DownloadComplete(ClaimNumber As String) As String

    Dim FSO As FileSystemObject
    Set FSO = New FileSystemObject

    Dim Username As String
    Username = Environ("username")

    Dim DownloadFolder As String
    DownloadFolder = "C:\Users\" & Username & "\Downloads"

    Debug.Print DownloadFolder

    Dim Folder As Scripting.Folder
    Set Folder = FSO.GetFolder(DownloadFolder)

    On Error Resume Next
    Dim File As Scripting.File
    For Each File In Folder.Files
        If File.name Like "*" & ClaimNumber & "*" Then
            If Err.Number = 0 Then
                Completed = "Yes"
            Else
                Completed = "No"
            End If
            On Error GoTo 0
        End If
    Next File

    DownloadComplete = Completed

End Function