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

Question

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

我想做两件事：

1. 插入一个循环，以便脚本等待某些元素出现，然后才会继续执行。我在this 页面上找到了一些东西，但是，我也想建立一个最长等待时间，就像那里建议的那样。
2. 由于代码正在下载文件，它还应该等待下载完成，然后才能继续。目前我正在使用“等待”命令，但下载时间可能会有所不同，并且在这种情况下脚本将停止。我也找到了解决方案，等待“打开文件夹”按钮出现，但我不确定如何在我的代码中实现它。这是我找到的代码：Link

另外，也许还有另一种解决方案，不要将文件保存在默认下载位置，而是执行“另存为”，然后以这种方式定义目录和文件名？

提前谢谢你！

以下是我现在正在使用的源代码。例如，我正在使用带有示例文件下载的 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

Answer 1

因此，在花费了一些额外的时间后，我能够以我期望的方式解决我的问题，我将在下面发布解决方案。 我感谢大家的建议，我希望所有建议的解决方案在未来对其他人来说都是一个很好的发现:)

所以代码的作用是进入一个网站，点击下载链接，然后点击“保存”按钮，下载开始了。然后Script正在等待“打开文件夹”按钮出现，这意味着下载已经完成。 下载文件后，脚本将文件复制到桌面，重命名，然后从下载文件夹中删除原始文件。

  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

Answer 2

如果目标是从网站下载文件（例如从 https://docs.microsoft.com/en-us/power-bi/sample-financial-download 下载文件的 Financial Sample.xlsx - 并且该页面实际上不需要显示 - 那么还有另一种方法可能会减少问题。

您可能已经发现，以编程方式等待页面加载、单击按钮等可能会让人头疼。这与不可预见/不可预测的因素（例如网络延迟、源更改等）复合。

以下方法适用于任何文件 URL（和任何文件类型），即使页面不包含实际链接（如许多视频共享网站）。

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

通过你的例子，我们可以像这样使用它：

downloadFile "http://go.microsoft.com/fwlink/?LinkID=521962", _
    "C:\Users\Name\Desktop\Financial Sample.xlsx"

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

---

可能的安全警告（并阻止它）

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

这可以通过多种方式轻松解决：（#3 或 #4 是我的偏好）

1. 手动点击是。

2. 单击Yes，以编程方式“查找”类似于代码示例的窗口。

3. 在 Windows Internet 选项中启用选项“Access Data Sources Across Domains”：

   • 点击 Windows 键，输入“Internet 选项”，然后点击 Enter

   • 点击Security标签。

   • 在Internet下，点击Custom Level…

   • 在Miscellaneous 下，选择Access data sources across domains。

4. 使用文件的直接 URL 而不是间接链接（如 Microsoft 的 fwlink URL）。

   在您的示例中，直接链接是：

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

...所以你会下载文件（没有警告），如：

downloadFile "http://download.microsoft.com/download/1/4/E/14EDED28-6C58-4055-A65C-23B4DA81C4DE/Financial%20Sample.xlsx", _
    "C:\Users\Name\Desktop\Financial Sample.xlsx"

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

每个“可下载文件”（以及大多数“可查看文件”）都有隐藏在某处的实际文件名（包括文件扩展名），有些比其他文件更明显。

就您的链接而言，由于我知道目标是一个 Excel 文件（并且只有一个文件），因此使用 Firefox I：

1. 打开the source URL from your code，

2. 打开开发者日志控制台：

   • Firefox：Ctrl+Shift+J

   • Internet Explorer：F12 然后 Ctrl+2)

3. 点击浏览器中的“”下载链接然后取消下载链接。然后“实际”下载 URL 会出现在日志屏幕中，以复制并粘贴到上面的示例中。

该方法显然会根据站点和您的特定任务而有所不同，但是有多种方法可以获取“隐藏”文件名。另一种常见的方式（用于从单个页面下载大量视频等是简单的网络抓取。）一些试图偷偷摸摸的网站会插入额外的字符或转义字符串。

（看看你能不能找出 YouTube 或 Tumblr 上的模式；有点棘手，但他们在那里！在大多数网站上，一个很好的起点是 View Page Source 和 Ctrl+F 搜索您期望的文件扩展名，即MP4。）

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

---

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

• Open Method (ADO Stream)

• Stream Object Properties, Methods, and Events

• Status Property (XMLHTTP)

• SaveToFile Method

Answer 3

您可以使用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