VBA code to wait until file download from IE is complete

后端 未结 1 1298
深忆病人
深忆病人 2021-01-15 04:46

I\'m trying to download an excel file from a webpage and so far I was able to open the webpage, navigate and click on save button but I need to access that excel file once i

相关标签:
1条回答
  • 2021-01-15 05:28

    This code uses a similar technique to what you have, started, but in addition it will wait for the "Open folder" button to appear in the 'Frame Notification Bar', which will indicate the download is finished. Then it looks in the User's Download folder for a 'very recently added' file and moves it to the place you select. The Code has some Debug.Print statements for error messages, which you may want to change/remove.

    Hope this works for you....

        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
    
    0 讨论(0)
提交回复
热议问题