xlDownloader - pobieranie plików z internetu z paskiem postępu   strona główna:
A po co ten Excel ;-)
 
    Rozwiązanie to pochodzi z przykładu napisanego dla VB6 które znalazłem kiedyś w sieci i jedynie odrobinę przerobiłem na potrzeby   working downloader    http://www.vbforums.com
Excela skracając kod od minimum i rozszerzając funkcjonalność o dane dotyczące szczegółów pobieranego pliku.  
 
uf
    O jaką funkcjonalność mi chodzi? Chciałbym móc 
 
pobierać plik z internetu i zapisać go na dysku pod   
wskazaną nazwa. Jednak samo pobranie pliku można  
zrobić o wieeeeelw prościej. Zajeży mi jednak na tym  
aby stan pobierania odwzorować na ProgressBar'ze i   
to już proste nie jest :-)  
 
Całość opiera się o zaimplementowanie interfejsu    olelib.tlb http://www.brothersoft.com
IBindStatusCallback będącego składnikiem biblioteki   
olelib.tlb  
 
Bibliotekę tą trzeba by zarejestrować poprzez Regsvr32.  
Ja robiłem to już dawno ale wydaje mi sięże obyło się  
bez rejestracji.  
Skopiowałem tę bibliotekę do System32, a z poziomu   Rejestrowanie formantu ActiveX (.ocx) ręcznie
VBA dodałem referencję do niej.  
 
Całość działa i wygląda jak na obrazku..  
 
 
W mod. Class Download  
 
Option Explicit  
 
Public Event DownloadStarted()  
Public Event DownloadComplete()  
Public Event DownloadProgress(ByVal ReceivedBytes As Long, ByVal TotalBytes As Long)  
Public Event DownloadAborted(ByVal ErrNumber As Long, ErrDescription As String)  
 
Implements IBindStatusCallback  
 
Private mobjBinding     As IBinding  
 
Private Sub IBindStatusCallback_OnProgress(ByVal ulProgress As Long, _  
                                           ByVal ulProgressMax As Long, _  
                                           ByVal ulStatusCode As olelib.BINDSTATUS, _  
                                           ByVal szStatusText As Long)  
    If ulProgressMax > 0 Then  
        RaiseEvent DownloadProgress(ulProgress, ulProgressMax)  
    End If  
End Sub  
 
Private Sub IBindStatusCallback_OnStartBinding(ByVal dwReserved As Long, _  
                                               ByVal pib As olelib.IBinding)  
    Set mobjBinding = pib  
    RaiseEvent DownloadStarted  
End Sub  
 
Private Sub IBindStatusCallback_OnStopBinding(ByVal hresult As Long, _  
                                              ByVal szError As Long)  
    If hresult = 1 Then  
        RaiseEvent DownloadComplete  
    Else  
        RaiseEvent DownloadAborted(hresult, (szError))  
    End If  
    Set mobjBinding = Nothing  
End Sub  
 
Public Sub StopDownload()  
    If Not (mobjBinding Is Nothing) Then  
        mobjBinding.Abort  
        Set mobjBinding = Nothing  
    End If  
End Sub  
 
Public Sub StartDownload(ByVal Source As String, _  
                         ByVal Dest As String, _  
                Optional ByVal Username As String, _  
                Optional ByVal Password As String)  
                  
    If mobjBinding Is Nothing Then  
        URLDownloadToFileW Me, Source, Dest, 0, Me  
    End If  
End Sub  
 
 
Private Sub IBindStatusCallback_GetBindInfo(grfBINDF As olelib.BINDF, _  
                                            pbindinfo As olelib.BINDINFO)  
'  
End Sub  
 
Private Function IBindStatusCallback_GetPriority() As Long  
'  
End Function  
 
Private Sub IBindStatusCallback_OnDataAvailable(ByVal grfBSCF As olelib.BSCF, _  
                                                ByVal dwSize As Long, _  
                                                pformatetc As olelib.FORMATETC, _  
                                                pStgmed As olelib.STGMEDIUM)  
'  
End Sub  
 
Private Sub IBindStatusCallback_OnLowResource(ByVal reserved As Long)  
'  
End Sub  
 
Private Sub IBindStatusCallback_OnObjectAvailable(riid As olelib.UUID, _  
                                                  ByVal pUnk As stdole.IUnknown)  
'  
End Sub  
 
 
Tu powstrzymam się od jakiegokolwiek komentarza ;-P  
Samo Implements jest używane w Excelu niezmierne żadko. Ja, innego przykładu jak ten nie widziałem. :-)  
 
I wykorzystanie...  
 
Private Sub UserForm_Initialize()  
    Me.TextBox1.Text = "http://www.apocotenexcel.pl/xlstatki.zip"  
 
    With Me.TextBox2  
        .DropButtonStyle = fmDropButtonStyleReduce  
        .ShowDropButtonWhen = fmShowDropButtonWhenAlways  
        .Text = ThisWorkbook.Path & "\" & strFileName(Me.TextBox1.Text)  
    End With  
      
    Me.ProgressBar1.Max = 100  
    Set mobjDownload = New Download  
End Sub  
 
Private Sub TextBox1_Change()  
    If Me.TextBox1.Text Like "http://*.*" Then  
        Me.TextBox2.Text = ThisWorkbook.Path & "\" & strFileName(Me.TextBox1.Text)  
    End If  
End Sub  
 
Private Sub TextBox2_DropButtonClick()  
    Dim strPath As String   BrowseForFolderName_Shell
    strPath = BrowseForFolderName_Shell  
    Me.TextBox2.Text = IIf(Len(strPath) > 0, strPath, ThisWorkbook.Path) & "\" & strFileName(Me.TextBox1.Text)  
End Sub  
 
W TextBox1 - adres URL pliku, w TextBox2 - ścieżka na dysku gdzie plik zapiszemy. Dodałem możliwość zmiany Folderu docelowego -   
nazwa pliku pochodzi (domyslnie) z nazwy pliku z adresu URL...  
 
Private WithEvents mobjDownload As Download  
Private sTime As Single  
 
Private Sub CommandButton1_Click()  
    Dim strFilePath As String  
    sTime = VBA.Timer  
    mobjDownload.StartDownload Me.TextBox1.Value, Me.TextBox2.Value  
End Sub  
 
Procedura pod przyciskiem Start wywołuje procedurę StartDownload z modułu Download.  
 
Private Sub mobjDownload_DownloadProgress(ByVal ReceivedBytes As Long, ByVal TotalBytes As Long)  
    Me.labALL.Caption = Round(TotalBytes / 1024, 2) & " kB"  
    Me.labSum.Caption = Round(ReceivedBytes / 1024, 2) & " kB"  
    Me.labStan.Caption = "W toku..."  
    If VBA.Timer - sTime > 0 Then  
        Me.labSek.Caption = CLng((ReceivedBytes / 1024) / (VBA.Timer - sTime)) & " kb/s"  
        Me.labCzas.Caption = Round((TotalBytes - ReceivedBytes) / _  
                             CLng(ReceivedBytes / (VBA.Timer - sTime)), 2) & " sek"  
    End If  
    Me.ProgressBar1.Value = CLng(100 * (ReceivedBytes / TotalBytes))  
    DoEvents  
End Sub  
 
To zdarzenie obiektu mobjDownload następujące w trakcie pobierania pliku. Na podstawie jego argumentów a więc:  
 - ReceivedBytes - ilości dotychczas pobranych bajtów  
 - TotalBytes - wielkości ściąganego pliku  
oraz czasu jaki upłynąłpomiędzy kolejnymi wywołaniami tego zdarzenia  
Możemy wyliczyć informacje o szczegółach pobierania a więc: szybkość pobierania (kB/s) i przewidywany czas pobierania (s).  
Procent bedący wynikiem dzielenia ilości pobranych danych do wielkości pliku to pozycja jaką powinien wskazywać ProgressBar.  
 
Private Sub mobjDownload_DownloadComplete()    
    Me.labStan.Caption = "Download complete"   Przykład do pobrania:
    Me.ProgressBar1.Value = 0   xlDownloader.zip
End Sub  
   
i reszta dość jasna...