来自VBA内的异步文件下载(Excel)

Question

我已经尝试过使用许多不同的技术......一个运行得非常好,但在运行时使用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

和

IF URLDownloadToFile(0, "URL", "FilePath", 0, 0) Then
End If

我还使用(成功)代码从Excel中编写vbscript,然后使用wscript运行并等待回调.但同样,这并非完全异步,仍然会占用一些代码.

我想在事件驱动的类中下载文件,VBA代码可以使用"DoEvents"在大循环中执行其他操作.当一个文件完成时,它可以触发一个标志,代码可以在等待另一个文件时处理该文件.

这是从内联网站点提取excel文件.如果这有帮助.

因为我相信有人会问,除了VBA,我不能使用任何东西.这将在工作场所使用,90%的计算机是共享的.我非常怀疑他们会因为让我获得Visual Studio而花费很多钱.所以我必须与我所拥有的一起工作.

任何帮助将不胜感激.

Answer 1

你可以在异步模式下使用xmlhttp和一个类来处理它的事件:

http://www.dailydoseofexcel.com/archives/2006/10/09/async-xmlhttp-calls/

那里的代码解决了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

Answer 2

不确定这是否是标准程序,但我不想过分混乱我的问题所以阅读它的人可以更好地理解它.

但我找到了一个替代我的问题的解决方案,它更符合我最初的要求.再次感谢蒂姆,因为他让我走上正轨,他对ADODB.Stream的使用是我解决方案的重要组成部分.

这使用了Microsoft WinHTTP Services 5.1 .DLL,它应该包含在一个版本或另一个版本的Windows中,如果不是很容易下载的话.

我在名为"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

这与Tim描述的内容之间的主要区别在于WINHTTPRequest有自己的内置事件,我可以将它们包含在一个整洁的小类中,并在任何地方重用.对我来说,这是一个比调用XMLHttp更优雅的解决方案,然后将其传递给类来等待它.

将它包含在这样的类中意味着我可以按照这个方式做一些事情.

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 

我只是用URL(1,N)遍历URL(),URL是URL,而URL(2,N)是保存位置.

我承认可以简化一下,但它现在可以为我完成工作.只是为了感兴趣的人扔掉我的解决方案.