IEからのファイルダウンロードが完了するまで待つVBAコード

Question

ウェブページから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

を保存します。このコードは、あなたが持っているものと同様の技術を使用し始め、それに加えて、それは "に表示される「フォルダを開く」ボタンをお待ちしていますFrame Notification Bar 'をクリックすると、ダウンロードが完了したことが示されます。次に、ユーザーのダウンロードフォルダ内の「最近追加された」ファイルを探し、選択した場所に移動します。コードには、エラーメッセージ用の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