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 Ladetyp
  Download
  Upload
End Enum
 
 
Public Sub FTPLoad(ByVal Laderichtung As Ladetyp, _
                   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: www.dbwiki.net oder www.dbwiki.de
 
 Dim objShell     As New Shell
 Dim ftpFolder    As folder
 Dim lokalFolder  As folder
 Dim FI           As FolderItem
 Dim strFTPpfad   As String
 Dim i            As Integer
 
 strFTPpfad = "ftp://" & Benutzer & ":" & Passwort & "@" & Server & "/" & RemoteOrdnerpfad
 Set ftpFolder = objShell.NameSpace(strFTPpfad)
 Set lokalFolder = objShell.NameSpace(LokalerOrdnerpfad)
 
 'Ordner
 If Dateiname = vbNullString Then
 
   If Laderichtung = Ladetyp.Download Then
     'ganzen Ordner herunterladen
     lokalFolder.CopyHere ftpFolder
   ElseIf Laderichtung = Ladetyp.Upload Then
     'ganzen Ordner hinaufladen
     ftpFolder.CopyHere lokalFolder
   End If
 
 'Datei
 Else
 
   If Laderichtung = Ladetyp.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 = Ladetyp.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

Zusatzinformationen:

Beim Testen des Codes wurde folgendes Verhalten festgestellt:

  • Wenn beim Download die Datei sofort direkt mit ihrem Dateinamen angesprochen wird, hat die heruntergeladene Datei die Größe 0.
Abhilfe: Vor dem Download der gewünschten Datei wird eine beliebige Datei im Ordner über ihren Index angesprochen.
  • Der zweite Parameter vOptions der Funktion CopyHere ist unwirksam. Vermutlich war er in früheren Windows-Versionen wirksam.
  • Mit der NewFolder-Methode des Shell-Automation-Objekts kann nur ein lokaler Ordner angelegt werden, aber kein Internet-Ordner auf dem FTP-Server.


Aufruf

  • Ordner:
    Wenn der Parameter Dateiname nicht angegeben wird, wird der ganze Ordner herunter- bzw. hinaufgeladen. Wenn der Ziel-Ordner nicht existiert, wird er angelegt. Ordner werden mit allen enthaltenen Unterordnern herunter- bzw. hinaufgeladen.
  • Datei:
    Wenn eine Datei herunter- bzw. hinaufgeladen wird, muss der angegebene Ziel-Ordner existieren.
 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

Wiki-Links


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