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.

'Quelle: http://www.dbwiki.net/
 
Option Explicit
 
 
Public Enum LadeTyp
   ltDownload
   ltUpload
End Enum
#If 0 Then 'Schutz vor Überschreiben
Dim ltDownload, ltUpload
#End If
 
Public Sub FTPLoad(ByVal Laderichtung As LadeTyp, _
                   Server As String, _
                   Benutzer As String, _
                   Passwort As String, _
                   LokalerOrdnerpfad As String, _
                   Optional Dateiname As String, _
                   Optional RemoteOrdnerpfad As String)
 
   'Verweis auf "Microsoft Shell Controls and Automation" ist notwendig
   '(Late Binding funktioniert nicht).
 
   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 = ltDownload Then
         'ganzen Ordner herunterladen
         lokalFolder.CopyHere ftpFolder
      ElseIf Laderichtung = ltUpload Then
         'ganzen Ordner hinaufladen
         ftpFolder.CopyHere lokalFolder
      End If
 
   Else
      'Datei
 
      If Laderichtung = ltDownload 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 = ltUpload Then
         'Datei hinaufladen
         ftpFolder.CopyHere lokalFolder.Items.Item(Dateiname)
      End If
 
   End If
 
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-Automatisierungsobjekts 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 strRelRemotePath     As String
   Dim strPfadLokalerOrdner As String
   Dim strDateiname         As String
 
   'Konfiguration
   strServer = "www.eine-domain.de"
   strBenutzer = "12345678"
   strPasswort = "geheim"
   strDateiname = "MeineDatei.pdf"
 
   'Beispiel 1: Download einer Datei
   strRelRemotePath = "htdocs/MeinUnterordner"
   strPfadLokalerOrdner = CurrentProject.Path & "\MeinUnterordner"
   Call FTPLoad(Download, strServer, strBenutzer, strPasswort, _
                strPfadLokalerOrdner, strDateiname, strRelRemotePath)
 
   'Beispiel 2: Upload einer Datei
   strRelRemotePath = "htdocs/MeinUnterordner"
   strPfadLokalerOrdner = CurrentProject.Path & "\EinUnterordner"
   Call FTPLoad(Upload, strServer, strBenutzer, strPasswort, _
                strPfadLokalerOrdner, strDateiname, strRelRemotePath)
 
   'Beispiel 3: Download eines Ordners
   strRelRemotePath = "htdocs/MeinUnterordner"
   strPfadLokalerOrdner = CurrentProject.Path
   Call FTPLoad(Download, strServer, strBenutzer, strPasswort, _
                strPfadLokalerOrdner, , strRelRemotePath)
 
   'Beispiel 4: Upload eines Ordners
   strRelRemotePath = "htdocs"
   strPfadLokalerOrdner = CurrentProject.Path & "\EinUnterordner"
   Call FTPLoad(Upload, strServer, strBenutzer, strPasswort, _
                strPfadLokalerOrdner, , strRelRemotePath)

Web-Links

Wikilinks


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