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”在大循环中执行其他操作。当一个文件完成时，它可以触发一个标志，代码可以在等待另一个文件时处理该文件。

这是从Intranet站点中提取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（2，N）是保存位置。

我承认可能会稍微简化一下，但它现在可以为我完成工作。只是为我感兴趣的人扔掉我的解决方案。

Answer 3

@TheFuzzyGiggler：+1：谢谢你回来分享。我知道这是一篇很老的帖子，但也许我会对这个对TheFuzzyGigglers代码的补充感兴趣（仅适用于课程）：

我添加了两个属性：

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

在我班上我有

 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

你可以从HTTPCallBack访问HTTP对象，并在这里做很多美好的事情;主要的是：它现在完全异步，易于使用。希望这可以帮助某人，因为OP帮助了我。

我将其进一步发展为一个类：检查my blog

来自VBA内的异步文件下载（Excel）

3 个答案: