VBA IE自动化 - 等待下载完成

时间:2018-02-01 10:37:42

标签: vba internet-explorer download browser-automation ie-automation

我正在尝试通过Internet Explorer自动执行某些任务,包括下载文件然后将其复制到其他目录并重命名。 我或多或少成功地找到了有关如何执行此操作的信息,代码正在运行,但它有例外,因此如果有人可以帮助我改进此代码,我将不胜感激。

我想做两件事:

  1. 插入一个循环,以便脚本等待某些元素出现,然后才会继续执行。我在this页面上找到了一些内容,但是,我也希望建立一个最长的等待时间,就像在那里建议的那样。
  2. 当代码下载文件时,它也应该等待下载完成,然后才继续。目前我正在使用“wait”命令,但下载时间可能会有所不同,在这种情况下脚本将停止。我也找到了一个解决方案,等到按钮“打开文件夹”出现,但我不知道如何在我的代码中实现它。以下是我找到的代码:Link
  3. 另外,也许有另一种解决方案,不是将文件保存在默认下载位置,而是执行“另存为”,然后以这种方式定义目录和文件名?

    提前谢谢!

    以下是我的源代码,我现在正在使用。例如,我正在使用带有示例文件下载的Microsoft页面。

        Option Explicit
    #If VBA7 Then
        Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
    
        Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
      (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, _
      ByVal lpsz2 As String) As LongPtr
    
    #Else
        Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds 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
    #End If
    
    Sub MyIEauto()
    
        Dim ieApp As InternetExplorer
        Dim ieDoc As Object
    
        Set ieApp = New InternetExplorer
    
        ieApp.Visible = True
        ieApp.navigate "https://docs.microsoft.com/en-us/power-bi/sample-financial-download"
        Do While ieApp.Busy: DoEvents: Loop
        Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
    
        ieApp.navigate "http://go.microsoft.com/fwlink/?LinkID=521962"
        Do While ieApp.Busy: DoEvents: Loop
        Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
    
        Dim AutomationObj As IUIAutomation
        Dim WindowElement As IUIAutomationElement
        Dim Button As IUIAutomationElement
        Dim hWnd As LongPtr
    
        Set AutomationObj = New CUIAutomation
    
        Do While ieApp.Busy Or ieApp.readyState <> 4: DoEvents: Loop
        Application.Wait (Now + TimeValue("0:00:05"))
        hWnd = ieApp.hWnd
        hWnd = FindWindowEx(hWnd, 0, "Frame Notification Bar", vbNullString)
        If hWnd = 0 Then Exit Sub
    
        Set WindowElement = AutomationObj.ElementFromHandle(ByVal hWnd)
        Dim iCnd As IUIAutomationCondition
        Set iCnd = AutomationObj.CreatePropertyCondition(UIA_NamePropertyId, "Save")
    
        Set Button = WindowElement.FindFirst(TreeScope_Subtree, iCnd)
        Dim InvokePattern As IUIAutomationInvokePattern
        Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke
        Application.Wait (Now + TimeValue("0:00:05"))
    
        FileCopy "C:\Users\Name\Downloads\Financial Sample.xlsx", "C:\Users\Name\Desktop\Financial Sample.xlsx"
        Name "C:\Users\Name\Desktop\Financial Sample.xlsx" As "C:\Users\Name\Desktop\Hello.xlsx"
        Application.Wait (Now + TimeValue("0:00:01"))
    
        Dim KillFile As String
        KillFile = "C:\Users\Name\Downloads\Financial Sample.xlsx"
        If Len(Dir$(KillFile)) > 0 Then
        SetAttr KillFile, vbNormal
         Kill KillFile
    End If
    
    End Sub
    

3 个答案:

答案 0 :(得分:0)

您可以使用GetFileSizeEx函数或FSO GetFileFile.Size,并运行一个短Wait的循环1或2秒,直到文件大小停止更改?这应该意味着下载已经完成。

{EDIT} 这是一个使用后期绑定的FileSystemObject来获取文件大小的函数:

Function GetFilesize(FileName As String) As Long
    GetFilesize = -1 'Default value, for if file does not exist
    On Error GoTo ExitFunc

    Dim oFSO As Object, oFile As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")

    If oFSO.FileExists(GetFilesize) Then
        Set oFile = oFSO.GetFile(GetFilesize)
        GetFilesize = oFile.Size
    End If

    Set oFile = Nothing
    Set oFSO = Nothing
ExitFunc:
End Function

答案 1 :(得分:0)

如果目标是从网站下载文件(例如来自Financial Sample.xlsx的{​​{1}} - 并且该页面实际上不需要显示 - 那么还有另一个你可能会发现问题较少的方式。

正如您可能已经发现的那样,以编程方式等待页面加载,单击按钮等会变得很头疼。这具有无法预料/不可预测的因素,如网络延迟,源变化等。

以下方法适用于任何文件网址(以及任何文件类型),即使网页不包含实际链接(如许多视频共享网站)。

https://docs.microsoft.com/en-us/power-bi/sample-financial-download

通过您的示例,我们可以使用它:

Sub downloadFile(url As String, filePath As String)
'Download file located at [url]; save to path/filename [filePath]

    Dim WinHttpReq As Object, attempts As Integer, oStream
    attempts = 3 'in case of error, try up to 3 times
    On Error GoTo TryAgain
TryAgain:
    attempts = attempts - 1
    Err.Clear
    If attempts > 0 Then
        Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
        WinHttpReq.Open "GET", url, False
        WinHttpReq.send

        If WinHttpReq.Status = 200 Then
            Set oStream = CreateObject("ADODB.Stream")
            oStream.Open
            oStream.Type = 1
            oStream.Write WinHttpReq.responseBody
            oStream.SaveToFile filePath, 1 ' 1 = no overwrite, 2 = overwrite
            oStream.Close
            Debug.Print "Saved [" & url & "] to [" & filePath & "]"
        End If
    Else
        Debug.Print "Error downloading [" & url & "]"
    End If

End Sub

该文件将保存到指定目的地。

可能的安全警告(并阻止它)

使用此方法,可能会弹出安全警告(取决于您的设置和Windows版本)...

warning

这可以通过多种方式轻松处理:(#3或#4是我的偏好)

  1. 手动点击

  2. 通过编程方式点击&#34;查找&#34;窗口就像你的代码样本。

  3. 启用选项&#34; downloadFile "http://go.microsoft.com/fwlink/?LinkID=521962", _ "C:\Users\Name\Desktop\Financial Sample.xlsx" &#34;在Windows Internet选项中:

      
        
    • 点击 Windows Key Windows键,输入“Internet选项&#39;”,然后按 Enter

    •   
    • 点击Access Data Sources Across Domains标签。

    •   
    • Security下,点击Internet

    •   
    • Custom Level…下,选择 Miscellaneous

    •   
  4. 使用文件的直接网址 而非间接链接(例如Microsoft的Access data sources across domains网址&#39; S)。

      

    对于您的示例,直接链接是:

         

    fwlink

  5. ...所以你要下载文件(没有警告),如:

    http://download.microsoft.com/download/1/4/E/14EDED28-6C58-4055-A65C-23B4DA81C4DE/Financial%20Sample.xlsx

    我使用此方法时没有问题,任何时候scraping都包含文档,视频,MP3,PDF等文件。

    每个&#34;可下载文件&#34; (以及大多数&#34;可查看的文件&#34;)具有隐藏在某处的实际文件名(包括文件扩展名),其中一些比其他文件更明显。

    对于您的链接,因为我知道目标是 Excel文件 (并且只有一个文件),所以使用Firefox I:

    1. 已打开the source URL from your code

    2. 打开了开发人员日志记录控制台:

      • Firefox: Ctrl + Shift + J

      • Internet Explorer: F12 然后 Ctrl + 2

    3. 点击&#34; 'Download the sample directly'&#34;在浏览器 中下载链接,然后取消下载链接 。 &#34;实际&#34;然后下载URL出现在Logging屏幕中,以复制和放大粘贴到上面的示例。

    4. 该方法显然会根据网站和您的特定任务而有所不同,但有多种方法可以获取&#34;隐藏&#34;文件名。另一个常见的(用于从单个页面下载一堆视频等)将是一个简单的网页搜索。)一些试图偷偷摸摸的网站将插入额外的字符或逃避字符串。

      (看看你是否可以在YouTube或Tumblr上找出模式;有点棘手,但他们会在那里!在大多数网站上开始的好地方是 downloadFile "http://download.microsoft.com/download/1/4/E/14EDED28-6C58-4055-A65C-23B4DA81C4DE/Financial%20Sample.xlsx", _ "C:\Users\Name\Desktop\Financial Sample.xlsx" Ctrl + F 搜索您期待的文件扩展名,即View Page Source。)

      最后一部分可能会使这种从URL获取文件的方法比实际更复杂 - 大多数网站都不会非常努力地隐藏您已经可以下载/手动查看的文件的名称!

      有关从URL保存数据流的更多信息:

答案 2 :(得分:0)

所以,经过一些额外的时间,我能够以我期待的方式解决我的问题,并且我将在下面发布解决方案。 我感谢大家的建议,我希望所有建议的解决方案将来都能成为其他人的好发现:)

那么代码的作用是什么,它会进入一个网站,按下载链接,然后按&#34;保存&#34;按钮,下载开始。然后脚本正在等待&#34;打开文件夹&#34;按钮出现,这意味着下载已完成。 下载文件后,脚本会将文件复制到桌面,重命名,然后从“下载”文件夹中删除原始文件。

  Option Explicit
#If VBA7 Then
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _


 (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, _
  ByVal lpsz2 As String) As LongPtr

#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds 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
#End If

Sub MyIEauto()

Dim ieApp As InternetExplorer
Dim ieDoc As Object
Const DebugMode As Boolean = False

Set ieApp = New InternetExplorer

ieApp.Visible = True
ieApp.navigate "https://docs.microsoft.com/en-us/power-bi/sample-financial-download"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop

ieApp.navigate "http://go.microsoft.com/fwlink/?LinkID=521962"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop

Dim AutomationObj As IUIAutomation
Dim WindowElement As IUIAutomationElement
Dim Button As IUIAutomationElement
Dim hWnd As LongPtr

Set AutomationObj = New CUIAutomation

Do While ieApp.Busy Or ieApp.readyState <> 4: DoEvents: Loop
Application.Wait (Now + TimeValue("0:00:05"))
hWnd = ieApp.hWnd
hWnd = FindWindowEx(hWnd, 0, "Frame Notification Bar", vbNullString)
If hWnd = 0 Then Exit Sub

Set WindowElement = AutomationObj.ElementFromHandle(ByVal hWnd)
Dim iCnd As IUIAutomationCondition
Set iCnd = AutomationObj.CreatePropertyCondition(UIA_NamePropertyId, "Save")

Set Button = WindowElement.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke

Do
Set iCnd = AutomationObj.CreatePropertyCondition(UIA_NamePropertyId, "Open folder")
Set Button = WindowElement.FindFirst(TreeScope_Subtree, iCnd)
    Sleep 200
    If DebugMode Then Debug.Print Format(Now, "hh:mm:ss"); "Open folder"
    DoEvents
Loop While Button Is Nothing


  FileCopy "C:\Users\" & Environ("UserName") & "\Downloads\Financial Sample.xlsx", "C:\Users\" & Environ("UserName") & "\Desktop\Financial Sample.xlsx"
Name "C:\Users\" & Environ("UserName") & "\Desktop\Financial Sample.xlsx" As "C:\Users\" & Environ("UserName") & "\Desktop\Hello.xlsx"
Application.Wait (Now + TimeValue("0:00:01"))

Dim KillFile As String
KillFile = "C:\Users\" & Environ("UserName") & "\Downloads\Financial Sample.xlsx"
If Len(Dir$(KillFile)) > 0 Then
SetAttr KillFile, vbNormal
 Kill KillFile
End If

End Sub

此外,如果有人将搜索如何循环代码,直到元素出现,这里是下面的代码。它循环四次,然后显示一条消息。

intCounter = 0

Do Until IsObject(objIE.document.getElementById("btnLogIn")) = True Or intCounter > 3
DoEvents
Application.Wait (Now + TimeValue("0:00:01"))
intCounter = intCounter + 1
If intCounter = 4 Then
MsgBox "Time out."
End If
Loop