VBA Tipp: Datei-Download und -Upload (FTP, Shell-Objekt)

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

  • Ich möchte eine Datei oder einen kompletten Ordner von einem Internet-Server herunterladen bzw. auf einen Internet-Server hinaufladen.
  • Der Zugang zu dem Internet-Verzeichnis erfolgt über das FTP-Protokoll.
  • Für den FTP-Zugang zum Server ist ein Benutzername und ein Passwort erforderlich.

Lösung

Das geht mit der folgenden Enumeration und VBA-Funktion, die in einem globalen Modul hinterlegt werden. Die VBA-Funktion benutzt das Shell-Objekt. Dazu ist ein Verweis auf "Microsoft Shell Controls and Automation" notwendig.

Public Enum Ladetypen
  Download
  Upload
End Enum
 
 
Public Sub FTPLoad(ByVal Laderichtung As Ladetypen, _
                   ByVal Server As String, _
                   ByVal Benutzer As String, _
                   ByVal Passwort As String, _
                   ByVal LokalerOrdnerpfad As String, _
                   Optional ByVal Dateiname As String = vbNullString, _
                   Optional ByVal RemoteOrdnerpfad As String = vbNullString)
 
 'Verweis auf "Microsoft Shell Controls and Automation" notwendig (Late Binding funktioniert nicht).
 'Quelle: http://www.dbwiki.net/
 
 Dim objShell As New Shell
 Dim ftpFolder As folder
 Dim lokalFolder As folder
 Dim strFTPpfad As String
 Dim i As Integer
 
 strFTPpfad = "ftp://" & Benutzer & ":" & Passwort & "@" & Server & "/" & RemoteOrdnerpfad
 Set ftpFolder = objShell.NameSpace(strFTPpfad)
 Set lokalFolder = objShell.NameSpace(LokalerOrdnerpfad)
 
 If Dateiname = vbNullString Then
 
   If Laderichtung = Ladetypen.Download Then
     'ganzen Ordner herunterladen
     lokalFolder.CopyHere ftpFolder
   ElseIf Laderichtung = Ladetypen.Upload Then
     'ganzen Ordner hinaufladen
     ftpFolder.CopyHere lokalFolder
   End If
 
 Else
 
   If Laderichtung = Ladetypen.Download Then
     'erste Datei im Ordner über ihren Index ansprechen
     Set FI = ftpFolder.Items.Item(0)
     'Datei herunterladen
     lokalFolder.CopyHere ftpFolder.Items.Item(Dateiname)
   ElseIf Laderichtung = Ladetypen.Upload Then
     'Datei hinaufladen
     ftpFolder.CopyHere lokalFolder.Items.Item(Dateiname)
   End If
 
 End If
 
 Set lokalFolder = Nothing
 Set ftpFolder = Nothing
 Set objShell = Nothing
 
End Sub

Zusatzinfo's zum Code:

Beim Testen des Codes wurde folgendes Verhalten festgestellt:

  • Wenn beim Download die Datei direkt mit ihrem Dateinamen angesprochen wird, hat die heruntergeladene Datei die Größe 0.
Abhilfe: Vor dem Download wird eine beliebige Datei im Ordner über ihrem Index angesprochen.
  • Der zweite Parameter vOptions der Funktion CopyHere ist unwirksam. Vermutlich war er in früheren Windows-Versionen wirksam.


Aufruf

  • Wenn kein Dateiname angegeben wird, wird der ganze Ordner herunter- bzw. hinaufgeladen.
  • Ordner werden mit allen enthaltenen Unterordnern herunter- bzw. hinaufgeladen.
  • Wenn der Zielordner nicht existiert, wird er automatisch erstellt. Der Zielordner bekommt automatisch den Namen des Quellordners.
 Dim strServer As String
 Dim strBenutzer As String
 Dim strPasswort As String
 Dim strRelativerPfadRemoteordner As String
 Dim strPfadLokalerOrdner As String
 Dim strDateiname As String
 
 'Konfiguration
 strServer = "www.meine-domain.de"
 strBenutzer = "12345678"
 strPasswort = "geheim"
 strDateiname = "MeineDatei.pdf"
 
 'Beispiel 1: Download einer Datei
 strRelativerPfadRemoteordner = "htdocs/MeinUnterordner"
 strPfadLokalerOrdner = CurrentProject.Path & "\MeinUnterordner"
 Call FTPLoad(Download, strServer, strBenutzer, strPasswort, _
              strPfadLokalerOrdner, strDateiname, strRelativerPfadRemoteordner)
 
 'Beispiel 2: Upload einer Datei
 strRelativerPfadRemoteordner = "htdocs/MeinUnterordner"
 strPfadLokalerOrdner = CurrentProject.Path & "\MeinUnterordner"
 Call FTPLoad(Upload, strServer, strBenutzer, strPasswort, _
              strPfadLokalerOrdner, strDateiname, strRelativerPfadRemoteordner)
 
 'Beispiel 3: Download eines Ordners
 strRelativerPfadRemoteordner = "htdocs/MeinUnterordner"
 strPfadLokalerOrdner = CurrentProject.Path
 Call FTPLoad(Download, strServer, strBenutzer, strPasswort, _
              strPfadLokalerOrdner, , strRelativerPfadRemoteordner)
 
 'Beispiel 4: Upload eines Ordners
 strRelativerPfadRemoteordner = "htdocs"
 strPfadLokalerOrdner = CurrentProject.Path & "\MeinUnterordner"
 Call FTPLoad(Upload, strServer, strBenutzer, strPasswort, _
              strPfadLokalerOrdner, , strRelativerPfadRemoteordner)

Web-Links


Der Code wurde in Access 2010 unter Windows 7 erstellt und getestet.