等待文件从 IE 下载完成的 VBA 代码

Question

我正在尝试从网页下载一个 excel 文件，到目前为止我能够打开该网页，导航并单击保存按钮，但我需要在下载该 excel 文件后访问它。但有时下载需要时间，具体取决于文件的大小。有什么方法可以检查窗口并查看下载是否完成，然后才能继续打开下载的文件。下面是代码。

Dim o As IUIAutomation
Dim e As IUIAutomationElement
Set o = New CUIAutomation
h = IE.hwnd

h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)

If h = 0 Then

    MsgBox "Not Found"

End If


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)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke

上面的代码会保存下载文件

Answer 1

这段代码使用了与您已经开始的类似的技术，但除此之外，它还会等待“打开文件夹”按钮出现在“框架通知栏”中，这将表明下载已完成。然后它会在用户的下载文件夹中查找“最近添加”的文件并将其移动到您选择的位置。该代码有一些用于错误消息的 Debug.Print 语句，您可能想要更改/删除这些语句。

希望这对你有用......

    Option Explicit

'--Given an IE browser object with the yellow 'Frame Notification Bar' to download file and a File Name to save the downloaded file to,
'--This Sub will use UIAutomation to click the Save button, then wiat for the Open button, then look in the User Downloads folder
'--to get the file just downloaded, then move it to the full file name path given in Filename, then close the 'Frame Notification Bar'
'--DownloadFromIEFrameNotificationBar will return the following codes:
'-- -1 - could not find the Close button in the 'Frame Notification Bar', but file saved OK
'--  0 - succesfully downloaded and save file
'--  1 - could not find the 'Frame Notification Bar'
'--  2 - could not find the Save button in the 'Frame Notification Bar'
'--  3 - could not find the 'Open folder' button in the 'Frame Notification Bar'
'--  4 - could not find Very recent file (Last modified within 3 seconds) in the User Downloads folder

Public Function DownloadFromIEFrameNotificationBar(ByRef oBrowser As InternetExplorer, Filename As String) As Long
    Dim UIAutomation As IUIAutomation
    Dim eBrowser As IUIAutomationElement, eFNB As IUIAutomationElement, e As IUIAutomationElement
    Dim InvokePattern As IUIAutomationInvokePattern
    Dim DLfn As String

    DownloadFromIEFrameNotificationBar = 0

    Set UIAutomation = New CUIAutomation
    Set eBrowser = UIAutomation.ElementFromHandle(ByVal oBrowser.hwnd)

    '--Find 'Frame Notification Bar' element

    Set eFNB = FindFromAllElementsWithClassName(eBrowser, "Frame Notification Bar", 10)

    If eFNB Is Nothing Then
        Debug.Print "'Frame Notification Bar' not found"
        DownloadFromIEFrameNotificationBar = 1
        Exit Function
    End If

    '--Find 'Save' button element

    Set e = FindFromAllElementWithName(eFNB, "Save")
    If e Is Nothing Then
        Debug.Print "'Save' button not found"
        DownloadFromIEFrameNotificationBar = 2
        Exit Function
    End If

    '--'Click' the 'Save'  button

    Sleep 100
    Set InvokePattern = e.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke

    '--Wait for the file to download by waiting for the 'Open Folder' button to appear in the 'Frame Notification Bar'

    Set e = FindFromAllElementWithName(eFNB, "Open folder", 15)
    If e Is Nothing Then
        Debug.Print "'Open Folder' button not found"
        DownloadFromIEFrameNotificationBar = 3
        Exit Function
    End If

    '--Done with download, now look for a file that was very recently (with in 3 seconds) added to the User's Downloads folder and get the file name of it

    DLfn = FindVeryRecentFileInDownloads()

    If DLfn <> "" Then

        '--We got recent downloaded file, now Delete the file we are saving too (if it exists) so the Move file will be successful

        DeleteFile Filename
        MoveFile DLfn, Filename
    Else
        Debug.Print "Very recent file not found!"
        DownloadFromIEFrameNotificationBar = 4
    End If

    '--Close Notification Bar window

    Set e = FindFromAllElementWithName(eFNB, "Close")
    If e Is Nothing Then
        Debug.Print "'Close' button not found"
        DownloadFromIEFrameNotificationBar = -1
        Exit Function
    End If

    '--'Click' the 'Close'  button

    Sleep 100
    Set InvokePattern = e.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke
End Function

Private Function FindFromAllElementWithName(e As IUIAutomationElement, n As String, Optional MaxTime As Long = 5) As IUIAutomationElement
    Dim oUIAutomation As New CUIAutomation
    Dim ea As IUIAutomationElementArray
    Dim i As Long, timeout As Date

    timeout = Now + TimeSerial(0, 0, MaxTime)

    Do
        Set ea = e.FindAll(TreeScope_Subtree, oUIAutomation.CreateTrueCondition)

        For i = 0 To ea.length - 1
            If ea.GetElement(i).CurrentName = n Then
                Set FindFromAllElementWithName = ea.GetElement(i)
                Exit Function
            End If
        Next

        DoEvents

        Sleep 20
    Loop Until Now > timeout

    Set FindFromAllElementWithName = Nothing
End Function

Private Function FindFromAllElementsWithClassName(e As IUIAutomationElement, c As String, Optional MaxTime As Long = 5) As IUIAutomationElement
    Dim oUIAutomation As New CUIAutomation
    Dim ea As IUIAutomationElementArray
    Dim i As Long, timeout As Date

    timeout = Now + TimeSerial(0, 0, MaxTime)

    Do
        Set ea = e.FindAll(TreeScope_Subtree, oUIAutomation.CreateTrueCondition)

        For i = 0 To ea.length - 1
            If ea.GetElement(i).CurrentClassName = c Then
                Set FindFromAllElementsWithClassName = ea.GetElement(i)
                Exit Function
            End If
        Next

        DoEvents

        Sleep 20
    Loop Until Now > timeout

    Set FindFromAllElementsWithClassName = Nothing
End Function

Private Function FindVeryRecentFileInDownloads(Optional MaxSecs As Long = 3) As String
    Dim fso As New FileSystemObject, f As File, First As Boolean, lfd As Date, Folder As String
    Dim WS As Object

    On Error GoTo errReturn

    Set WS = CreateObject("WScript.Shell")

    '--Get Current user's Downloads folder path

    Folder = WS.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\{374DE290-123F-4565-9164-39C4925E467B}")
    First = True

    For Each f In fso.GetFolder(Folder).Files
        If First Then
            lfd = f.DateLastModified
            FindVeryRecentFileInDownloads = f.Path
            First = False
        ElseIf f.DateLastModified > lfd Then
            lfd = f.DateLastModified
            FindVeryRecentFileInDownloads = f.Path
        End If
    Next

    If First Then
        FindVeryRecentFileInDownloads = "" '--no files
    ElseIf MaxSecs <> -1 And DateDiff("s", lfd, Now) > MaxSecs Then
        FindVeryRecentFileInDownloads = "" '--no very recent file found
    End If

    Exit Function

errReturn:
    FindVeryRecentFileInDownloads = ""

End Function

Private Sub MoveFile(SourcePath As String, DestinationPath As String)
    Dim fso As New FileSystemObject
    CreateCompletePath Left(DestinationPath, InStrRev(DestinationPath, Application.PathSeparator))
    fso.MoveFile SourcePath, DestinationPath
End Sub

Public Sub CreateCompletePath(sPath As String)
    Dim iStart As Integer
    Dim aDirs As Variant
    Dim sCurDir As String
    Dim i As Integer

    sPath = Trim(sPath)
    If sPath <> "" And Dir(sPath, vbDirectory) = vbNullString Then
        aDirs = Split(sPath, Application.PathSeparator)
        If Left(sPath, 2) = Application.PathSeparator & Application.PathSeparator Then
            iStart = 3
        Else
            iStart = 1
        End If

        sCurDir = Left(sPath, InStr(iStart, sPath, Application.PathSeparator))

        For i = iStart To UBound(aDirs)
            If Trim(aDirs(i)) <> vbNullString Then
                sCurDir = sCurDir & aDirs(i) & Application.PathSeparator
                If Dir(sCurDir, vbDirectory) = vbNullString Then MkDir sCurDir
            End If
        Next i
    End If
End Sub