从 VBA (Excel) 中异步下载文件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/7747877/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Asynchronous File Downloads from Within VBA (Excel)
提问by TheFuzzyGiggler
I've already tried using many different techniques with this... One that works pretty nicely but still ties up code when running is using the api call:
我已经尝试过使用许多不同的技术......一种工作得很好但在运行时仍然绑定代码的方法是使用 api 调用：
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
and
和
IF URLDownloadToFile(0, "URL", "FilePath", 0, 0) Then
End If
I've also used (Successfully) code to write vbscript from within Excel and then running with it wscript and waiting for the callback. But again this isn't totally async and still ties up some of the code.
我还使用（成功）代码从 Excel 中编写 vbscript，然后使用它运行 wscript 并等待回调。但这又不是完全异步的，仍然会占用一些代码。
I'd like to have the files download in an event driven class and the VBA code can do other things in a big loop with "DoEvents". When one file is done it can trigger a flag and the code can process that file while waiting for another.
我想在事件驱动的类中下载文件，并且 VBA 代码可以使用“DoEvents”在一个大循环中做其他事情。当一个文件完成时，它可以触发一个标志，代码可以在等待另一个文件的同时处理该文件。
This is pulling excel files off of an Intranet site. If that helps.
这是从 Intranet 站点中提取 excel 文件。如果那有帮助。
Since I'm sure someone will ask, I can't use anything but VBA. This is going to be used at the workplace and 90% of the computers are shared. I highly doubt they'll spring for the business expense of getting me Visual Studio either. So I have to work with what I have.
因为我确定有人会问，所以我只能使用 VBA。这将在工作场所使用，并且 90% 的计算机是共享的。我非常怀疑他们是否会为获得我的 Visual Studio 的业务费用而跃跃欲试。所以我必须用我所拥有的来工作。
Any help would be greatly appreciated.
任何帮助将不胜感激。
回答by Tim Williams
You can do this using xmlhttp in asynchronous mode and a class to handle its events:
您可以在异步模式下使用 xmlhttp 和一个类来处理其事件：
http://www.dailydoseofexcel.com/archives/2006/10/09/async-xmlhttp-calls/
http://www.dailydoseofexcel.com/archives/2006/10/09/async-xmlhttp-calls/
The code there is addressing responseText, but you can adjust that to use .responseBody. Here's a (synchronous) example:
那里的代码解决了 responseText，但您可以调整它以使用 .responseBody。这是一个（同步）示例：
Sub FetchFile(sURL As String, sPath)
Dim oXHTTP As Object
Dim oStream As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
Set oStream = CreateObject("ADODB.Stream")
Application.StatusBar = "Fetching " & sURL & " as " & sPath
oXHTTP.Open "GET", sURL, False
oXHTTP.send
With oStream
.Type = 1 'adTypeBinary
.Open
.Write oXHTTP.responseBody
.SaveToFile sPath, 2 'adSaveCreateOverWrite
.Close
End With
Set oXHTTP = Nothing
Set oStream = Nothing
Application.StatusBar = False
End Sub
回答by TheFuzzyGiggler
Not sure if this is standard procedure or not but I didn't want to overly clutter my question so people reading it could understand it better.
不确定这是否是标准程序，但我不想让我的问题过于混乱，以便阅读它的人可以更好地理解它。
But I've found an alternate solution to my question that is more in-line with what I was originally requesting. Thanks again to Tim as he set me on the right track, and his use of ADODB.Stream is a vital part of my solution.
但是我找到了一个替代解决方案来解决我的问题，它更符合我最初的要求。再次感谢 Tim 让我走上正轨，他对 ADODB.Stream 的使用是我解决方案的重要组成部分。
This uses the Microsoft WinHTTP Services 5.1 .DLL that should be included with windows in one version or another, if not it is easily downloaded.
这使用 Microsoft WinHTTP Services 5.1 .DLL，它应该包含在一个或另一个版本的 windows 中，如果没有，它很容易下载。
I use the following code in a class called "HTTPRequest"
我在名为“HTTPRequest”的类中使用以下代码
Option Explicit
Private WithEvents HTTP As WinHttpRequest
Private ADStream As ADODB.Stream
Private HTTPRequest As Boolean
Private I As Double
Private SaveP As String
Sub Main(ByVal URL As String)
HTTP.Open "GET", URL, True
HTTP.send
End Sub
Private Sub Class_Initialize()
Set HTTP = New WinHttpRequest
Set ADStream = New ADODB.Stream
End Sub
Private Sub HTTP_OnError(ByVal ErrorNumber As Long, ByVal ErrorDescription As String)
Debug.Print ErrorNumber
Debug.Print ErrorDescription
End Sub
Private Sub HTTP_OnResponseFinished()
'Tim's code Starts'
With ADStream
.Type = 1
.Open
.Write HTTP.responseBody
.SaveToFile SaveP, 2
.Close
End With
'Tim's code Ends'
HTTPRequest = True
End Sub
Private Sub HTTP_OnResponseStart(ByVal Status As Long, ByVal ContentType As String)
End Sub
Private Sub Class_Terminate()
Set HTTP = Nothing
Set ADStream = Nothing
End Sub
Property Get RequestDone() As Boolean
RequestDone = HTTPRequest
End Property
Property Let SavePath(ByVal SavePath As String)
SaveP = SavePath
End Property
The main difference between this and what Tim was describing is that WINHTTPRequest has it's own built in events which I can wrap up in one neat little class and reuse wherever. It's to me, a more elegant solution than calling the XMLHttp and then passing it to a class to wait for it.
这与 Tim 所描述的主要区别在于 WINHTTPRequest 有它自己的内置事件，我可以将其包含在一个整洁的小类中并在任何地方重用。对我来说，这是一个比调用 XMLHttp 然后将它传递给一个类以等待它更优雅的解决方案。
Having it wrapped up in a class like this means I can do something along the lines of this..
将它包含在这样的课程中意味着我可以做一些类似的事情..
Dim HTTP(10) As HTTPRequest
Dim URL(2, 10) As String
Dim I As Integer, J As Integer, Z As Integer, X As Integer
While Not J > I
For X = 1 To I
If Not TypeName(HTTP(X)) = "HTTPRequest" And Not URL(2, X) = Empty Then
Set HTTP(X) = New HTTPRequest
HTTP(X).SavePath = URL(2, X)
HTTP(X).Main (URL(1, X))
Z = Z + 1
ElseIf TypeName(HTTP(X)) = "HTTPRequest" Then
If Not HTTP(X).RequestDone Then
Exit For
Else
J = J + 1
Set HTTP(X) = Nothing
End If
End If
Next
DoEvents
Wend
Where I just iterate through URL() with URL(1,N) is the URL and URL(2,N) is the save location.
我只是通过 URL() 迭代 URL(1,N) 是 URL，而 URL(2,N) 是保存位置。
I admit that can probably be streamlined a bit but it gets the job done for me for now. Just tossing my solution out there for anyone interested.
我承认这可能会简化一些，但它现在为我完成了工作。只是把我的解决方案扔给有兴趣的人。
回答by Johanness
@TheFuzzyGiggler: +1: Thanks for sharing back. I know its an old post but perhaps I make someone happy with this addidion to TheFuzzyGigglers code (works only in classes):
@TheFuzzyGiggler：+1：感谢分享。我知道这是一篇旧帖子，但也许我让某人对 TheFuzzyGigglers 代码的附加内容感到满意（仅在课堂上有效）：
I added two properties:
我添加了两个属性：
Private pCallBack as string
Private pCallingObject as object
Property Let Callback(ByVal CB_Function As String)
pCallBack = CB_Function
End Property
Property Let CallingObject(set_me As Object)
Set pCallbackObj = set_me
End Property
'and at the end of HTTP_OnResponseFinished()
CallByName pCallbackObj, pCallback, VbMethod
In my class I have
在我的课上我有
Private EntryCollection As New Collection
Private Sub Download(ByVal fromURL As String, ByVal toPath As String)
Dim HTTPx As HTTPRequest
Dim i As Integer
Set HTTPx = New HTTPRequest
HTTPx.SavePath = toPath
HTTPx.Callback = "HTTPCallBack"
HTTPx.CallingObject = Me
HTTPx.Main fromURL
pHTTPRequestCollection.Add HTTPx
End Sub
Sub HTTPCallBack()
Dim HTTPx As HTTPRequest
Dim i As Integer
For i = pHTTPRequestCollection.Count To 1 Step -1
If pHTTPRequestCollection.Item(i).RequestDone Then pHTTPRequestCollection.Remove i
Next
End Sub
You could access the HTTP object from the HTTPCallBack and do many beautiful things here; the main thing is: its perfectly asynchronous now and easy to use. Hope this helps someone as the OP helped me.
您可以从 HTTPCallBack 访问 HTTP 对象并在这里做很多漂亮的事情；主要的是：它现在完全异步并且易于使用。希望这可以帮助某人，因为 OP 帮助了我。
I developed this further into a class: check my blog
我将其进一步发展为一门课程：查看我的博客
