如何让VBA开始下载文件，而不等到它完成后再继续执行下一行代码

Question

我正在尝试优化生成报告的VBA应用程序。

此报告要求应用程序下载并嵌入多个图像。我认为这是应用程序中最大的瓶颈。

我的第一次尝试是让VBA执行Powershell命令，该命令将在生成报告的早期下载图像，然后应用程序在处理完数据后将其从HD嵌入。针对明显的安全问题，我的工作环境阻止VBA执行shell脚本。

经过几次不重要的失败尝试(试图用一个新的excel应用程序打开另一个/this xlsm工作簿，独立于我的vba线程，并在打开时执行及其变体(，我来到这里征求建议。

您如何使用vba开始下载图像(使用任何本地windows 10应用程序/命令/进程/…(，而不等待下载完成再进入下一行代码？

稍后，在应用程序中，我将有代码扫描目标目录，以确定文件是否已下载完成。如果没有，它将休眠并重复x次，然后失败。

更新：根据评论，我认为我非常接近解决方案。我在这次更新的底部包含了我目前正在使用的代码。现在的问题是，只要我之前至少对同一个url发出过一次请求，它就会快速下载文件。在第一个请求中，它会在"oXMLHTTP.send"上挂起一段时间，这段时间比我预期的通过浏览器下载文件所需的时间稍长，然后由于某种原因调整大小。

有人能帮我解决这个挂起的问题吗？和/或解释为什么这个代码称为"Workbook_WindowResize"？

这种情况发生在我的工作VPN内外。看看Fiddler，我可以看出只有两个请求被发送出去。

结果200：http://ipv4.download.thinkbroadband.com/50MB.zip?randomizer=ff%2014结果200：http://ipv4.download.thinkbroadband.com/50MB.zip?randomizer=ee%20761

结果和代码

在一个全新的工作簿中，我粘贴了更新结束时发现的代码。这就是我在直接窗口中得到的。

A took: 33375milliseconds
Pre DoEvents
Workbook_WindowResized
Post DoEvents
B took: 593milliseconds
Pre DoEvents
Post DoEvents
C took: 33797milliseconds
Pre DoEvents
Workbook_WindowResized
Post DoEvents
Do work
Pre DoEvents
Post DoEvents
a done
b done
c done

本工作簿代码

Private mlngStart As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Sub StartTimer()
mlngStart = GetTickCount
End Sub
Public Function EndTimer() As Long
EndTimer = (GetTickCount - mlngStart)
End Function
Function StartDownload(ByVal vWebFile As String, sPath As String) As Object
Dim oXHTTP As Object
Dim oStream As Object

Set oXHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
Set oStream = CreateObject("ADODB.Stream")
Application.StatusBar = "Fetching " & vWebFile & " as " & sPath
oXHTTP.Open "GET", vWebFile, False
oXHTTP.send
With oStream
.Type = 1 'adTypeBinary
.Open
.Write oXHTTP.responseBody
.SaveToFile sPath, 2 'adSaveCreateOverWrite
.Close
End With
Set StartDownload = oXHTTP
Set oStream = Nothing
Application.StatusBar = False
End Function
Sub FinishDownload(ByRef oXMLHTTP, ByVal vLocalFile As String)
'Wait for request to finish
Do While oXMLHTTP.readyState <> 4
DoEvents
Loop
End Sub
Function foo()
Dim dest As String
dest = "C:sandbox"
Dim a, b, c As Object
DoEvents
Url = "http://ipv4.download.thinkbroadband.com/50MB.zip?randomizer=ff" & Str(Math.Round(Math.Rnd(12) * 1000, 0))
Call StartTimer
Set a = StartDownload(Url, dest & "a.zip")
Debug.Print "A took: " & EndTimer & "milliseconds"

Debug.Print "Pre DoEvents"
DoEvents
Debug.Print "Post DoEvents"

Call StartTimer
Set b = StartDownload(Url, dest & "b.zip")
Debug.Print "B took: " & EndTimer & "milliseconds"

Debug.Print "Pre DoEvents"
DoEvents
Debug.Print "Post DoEvents"

Url = "http://ipv4.download.thinkbroadband.com/50MB.zip?randomizer=ee" & Str(Math.Round(Math.Rnd(12) * 1000, 0))

Call StartTimer
Set c = StartDownload(Url, dest & "c.zip")
Debug.Print "C took: " & EndTimer & "milliseconds"

Debug.Print "Pre DoEvents"
DoEvents
Debug.Print "Post DoEvents"

Debug.Print ("Do work")
Call bar

Debug.Print "Pre DoEvents"
DoEvents
Debug.Print "Post DoEvents"

Call FinishDownload(a, dest & "a.zip")
Debug.Print ("a done")
Call FinishDownload(b, dest & "b.zip")
Debug.Print ("b done")
Call FinishDownload(c, dest & "c.zip")
Debug.Print ("c done")
End Function
Function Download_File(ByVal vWebFile As String, ByVal vLocalFile As String) As Boolean
Dim oXMLHTTP As Object, i As Long, vFF As Long, oResp() As Byte
'You can also set a ref. to Microsoft XML, and Dim oXMLHTTP as MSXML2.XMLHTTP
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open "GET", vWebFile, False 'Open socket to get the website
oXMLHTTP.send 'send request
'Wait for request to finish
Do While oXMLHTTP.readyState <> 4
DoEvents
Loop
oResp = oXMLHTTP.responseBody 'Returns the results as a byte array
'Create local file and save results to it
vFF = FreeFile
If Dir(vLocalFile) <> "" Then Kill vLocalFile
Open vLocalFile For Binary As #vFF
Put #vFF, , oResp
Close #vFF
'Clear memory
Set oXMLHTTP = Nothing
End Function
Sub bar()
Dim F As Integer
F = FreeFile
Open "C:sandbox" & "example.txt" For Output As F
Close #F
End Sub

Private Sub Workbook_WindowResize(ByVal Wn As Window)
Debug.Print "Workbook_WindowResized"
End Sub

Answer 1

通过@Tim Williams在评论中提供的链接，我创建了这个，它很有效。

Function StartDownload(ByVal vWebFile As String) As Object
Dim oXMLHTTP As Object, i As Long, vFF As Long, oResp() As Byte
'You can also set a ref. to Microsoft XML, and Dim oXMLHTTP as MSXML2.XMLHTTP
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open "GET", vWebFile, True'Open socket to get the website
oXMLHTTP.Send 'send request
Set StartDownload = oXMLHTTP
End Function
Sub FinishDownload(ByRef oXMLHTTP, ByVal vLocalFile As String)
'Wait for request to finish
Do While oXMLHTTP.readyState <> 4
DoEvents
Loop
oResp = oXMLHTTP.responseBody 'Returns the results as a byte array
'Create local file and save results to it
vFF = FreeFile
If Dir(vLocalFile) <> "" Then Kill vLocalFile
Open vLocalFile For Binary As #vFF
Put #vFF, , oResp
Close #vFF
'Clear memory
Set oXMLHTTP = Nothing
End Sub
Function foo()
Dim dest As String
dest = "C:sandbox"
url = "http://ipv4.download.thinkbroadband.com/200MB.zip"
Dim a, b, c As Object
DoEvents
Set a = DownloadManager.StartDownload(url)
DoEvents
Set b = DownloadManager.StartDownload(url)
DoEvents
Set c = DownloadManager.StartDownload(url)
DoEvents
Debug.Print ("Do Something")

Call FinishDownload(a, dest & "a.zip")
Debug.Print ("a done")

Call FinishDownload(b, dest & "b.zip")
Debug.Print ("b done")
Call FinishDownload(c, dest & "c.zip")
Debug.Print ("c done")
End Function