asincroni del download di file da Entro VBA (Excel)

Question

Ho già provato con diverse tecniche con questo ... Uno che funziona abbastanza bene, ma ancora lega Codice durante l'esecuzione sta utilizzando la chiamata 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 

e

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

ho usato anche il codice (con successo) di scrivere VBScript da Excel e quindi eseguire con esso WScript e di attesa per la richiamata. Ma ancora una volta questo non è totalmente asincrono e continua a legare parte del codice.

Mi piacerebbe avere il download dei file in una classe guidata da eventi e il codice VBA può fare altre cose in un grande ciclo con "DoEvents". Al termine di un file, può attivare un flag e il codice può elaborare quel file mentre attende l'altro.

Questo sta estraendo i file excel da un sito Intranet. Se ciò aiuta.

Dato che sono sicuro che qualcuno chiederà, non posso usare altro che VBA. Questo verrà utilizzato sul posto di lavoro e il 90% dei computer è condiviso. Dubito fortemente che salteranno le spese aziendali per farmi avere anche Visual Studio. Quindi devo lavorare con quello che ho.

Qualsiasi aiuto sarebbe molto apprezzato.

Answer 1

È possibile eseguire questa operazione utilizzando XMLHTTP in modalità asincrona e una classe per gestire i suoi eventi:

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

Il codice non ci sta affrontando responseText, ma è possibile regolare che per utilizzare .responseBody. Ecco un (sincrono) Esempio:

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

Non sono sicuro se questo è procedura standard o no, ma non ho voglia di ingombrare eccessivamente la mia domanda in modo da persone che leggono si potrebbe capire meglio.

Ma ho trovato una soluzione alternativa alla mia domanda che è più in linea con ciò che originariamente stavo richiedendo. Grazie ancora a Tim per avermi messo sulla strada giusta, e il suo uso di ADODB.Stream è una parte vitale della mia soluzione.

Questo utilizza i servizi Microsoft WinHTTP 5.1 .DLL che dovrebbero essere inclusi con Windows in una versione o in un'altra, se non è facilmente scaricabile.

Io uso il seguente codice in una classe denominata "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 

La principale differenza tra questo e quello che Tim stava descrivendo è che WinHttpRequest ha il proprio costruito in eventi che posso avvolgere in una ordinata piccola classe e riuso ovunque. È per me, una soluzione più elegante che chiamare XMLHttp e quindi passarlo a una classe per attenderlo.

averlo avvolto in una classe come questo significa che posso fare qualcosa sulla falsariga di questo ..

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 

dove ho appena scorrere URL() con l'URL (1, N) è l'URL e URL (2, N) è la posizione di salvataggio.

Ammetto che probabilmente si può semplificare un po ', ma per ora il lavoro è finito. Sto lanciando la mia soluzione là fuori per chiunque sia interessato.

Answer 3

@TheFuzzyGiggler: +1: Grazie per la condivisione. So che è un vecchio post, ma forse rendere felice qualcuno con questo addidion al codice TheFuzzyGigglers (funziona solo nelle classi):

ho aggiunto due proprietà:

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 

Nella mia classe ho

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 

È possibile accedere all'oggetto HTTP da HTTPCallBack e fare molte cose bellissime qui; la cosa principale è: è perfettamente asincrono ora e facile da usare. Spero che questo aiuti qualcuno come l'OP mi ha aiutato.

ho sviluppato questo ulteriore in una classe: controllare my blog