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 GetFile和File.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
相关问题
最新问题