Re: Datei vom Filesystem auf FTP Server kopieren

Tech-Archive recommends: Fix windows errors by optimizing your registry

From: Michael Schwimmer (schwimmer_at_t-online.de)
Date: 03/25/05 

Date: Fri, 25 Mar 2005 02:49:36 +0100

Hallo Alexander,

Alexander Lorenz schrieb:
> gibts eine Möglichkeit ein File (*.ppt), welches in einem bestimmten
> ordner ist via vba Code auf einen FTP Server zu kopieren, wenn man
> dessen Adresse inkl. Login kennt?

Dem Programm FTP, das auf jedem Rechner vorhanden sein sollte, kannst
du an der Kommandozeile den Pfad zu einer Textdatei übergeben. Die
darin stehenden Befehle werden nacheinander abgearbeitet.

Beispiel:

open 10.1.3.69
repas
xyz123
ascii
lcd C:\Uebertragung
cd /resy/pmc/sys/trz/kos/
put Montag Wochentag1

Es wird hier eine FTP-Verbindung zu 10.1.3.69 aufgebaut, User ist
repas, das Passwort ist xyz123, Übertragungsart ist Ascii (kann auch
binary sein).
Das lokale Verzeichnis ist C:\Uebertragung, das aktuelle Verzeichnis
des anderen Rechners ist /resy/pmc/sys/trz/kos/ .
Die Datei Montag des eigenen Rechners wird nach Wochentag1 des anderen
Rechners in das aktuelle Verzeichnis übertragen. Wenn du flexibel sein
willst, erzeuge vorher die Textdatei mittels VBA.
In VBA kannst du das dann mit dem Shell-Befehl starten:

Dateiname="FTP -s:C:\Uebertragung\Test.txt"
Shell Dateiname, 0

Du kannst auch einen anderen Weg einschlagen. Die wininet.dll
bietet da einige Funktionen. Nicht gleich erschrecken, ist eigentlich
alles halb so wild. Ich habe es eben einmal probeweise eine Datei via
FTP-Server in mein Homepageverzeichnis bei 1&1 hochgeladen.

Option Explicit
Private Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2

Private Const INTERNET_DEFAULT_FTP_PORT = 21
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_FLAG_PASSIVE = &H8000000
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4
Private Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000

Private Const MAX_PATH = 260
Private Const PassiveConnection As Boolean = True

Private Declare Function InternetCloseHandle _
   Lib "wininet" ( _
   ByRef hInet As Long _
   ) As Long
Private Declare Function InternetConnect _
   Lib "wininet.dll" Alias "InternetConnectA" ( _
   ByVal hInternetSession As Long, _
   ByVal sServerName As String, _
   ByVal nServerPort As Integer, _
   ByVal sUserName As String, _
   ByVal sPassword As String, _
   ByVal lService As Long, _
   ByVal lFlags As Long, _
   ByVal lContext As Long _
   ) As Long
Private Declare Function InternetOpen _
   Lib "wininet.dll" Alias "InternetOpenA" ( _
   ByVal sAgent As String, _
   ByVal lAccessType As Long, _
   ByVal sProxyName As String, _
   ByVal sProxyBypass As String, _
   ByVal lFlags As Long _
   ) As Long
Private Declare Function FtpSetCurrentDirectory _
   Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" ( _
   ByVal hFtpSession As Long, _
   ByVal lpszDirectory As String _
   ) As Boolean
Private Declare Function FtpGetCurrentDirectory _
   Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" ( _
   ByVal hFtpSession As Long, _
   ByVal lpszCurrentDirectory As String, _
   lpdwCurrentDirectory As Long _
   ) As Long
Private Declare Function FtpPutFile _
   Lib "wininet.dll" Alias "FtpPutFileA" ( _
   ByVal hConnect As Long, _
   ByVal lpszLocalFile As String, _
   ByVal lpszNewRemoteFile As String, _
   ByVal dwFlags As Long, _
   ByVal dwContext As Long _
   ) As Boolean
Private Declare Function InternetGetLastResponseInfo _
   Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
   lpdwError As Long, _
   ByVal lpszBuffer As String, _
   lpdwBufferLength As Long _
   ) As Boolean
   
Private Sub FTPAustesten()
Dim strFtpServer As String
Dim strUser As String
Dim strPass As String
Dim lngInet As Long
Dim lngConn As Long
Dim strActPath As String
Dim lngRet As Long
Dim strQuelldatei As String
Dim strZielname As String

strFtpServer = "192.168.100.3"
strUser = "Anonymous"
strPass = vbNullString
strQuelldatei = "C:\autoexec.bat"
strZielname = "autoe.bat"

lngInet = InternetOpen("Testprogramm", _
   INTERNET_OPEN_TYPE_PRECONFIG, _
   vbNullString, vbNullString, 0)
    
If lngInet = 0 Then
   MsgBox "Initialisierungsfehler"
   GoTo Fehlerbehandlung
End If

'Mit FTP-Server verbinden
lngConn = InternetConnect(lngInet, _
   strFtpServer, INTERNET_DEFAULT_FTP_PORT, _
   strUser, strPass, INTERNET_SERVICE_FTP, _
   INTERNET_FLAG_PASSIVE Or _
   INTERNET_FLAG_EXISTING_CONNECT, 0)
    
If lngConn = 0 Then
   MsgBox "Keine Verbindung"
   GoTo Fehlerbehandlung
End If

strActPath = "/test"
'Aktuelles Verzeichnis wechseln
lngRet = FtpSetCurrentDirectory(lngConn, strActPath)
If lngRet = False Then
   MsgBox InetError, vbCritical, _
      "Ins Verzeichnis '" & strActPath & "' wechseln"
   GoTo Fehlerbehandlung
End If

'Aktuelles Verzeichnis abfragen
strActPath = String(MAX_PATH, 0)
lngRet = FtpGetCurrentDirectory(lngConn, strActPath, Len(strActPath))
If lngRet = False Then
   MsgBox InetError, vbCritical, "Aktuelles Verzeichnis ermitteln"
   GoTo Fehlerbehandlung
End If
strActPath = ApiStringTrim(strActPath)
MsgBox strActPath, , "Aktuelles Verzeichnis"

' Datei auf Server schieben
lngRet = FtpPutFile(lngConn, "C:\autoexec.bat", _
        "autoe.bat", FTP_TRANSFER_TYPE_UNKNOWN, 0)
If lngRet = False Then
   MsgBox InetError, vbCritical, _
      "Datei ins Verzeichnis kopieren"
   GoTo Fehlerbehandlung
End If

Fehlerbehandlung:
InternetCloseHandle lngConn
InternetCloseHandle lngInet

End Sub
Private Function InetError()
Dim lngFehlernummer As Long
Dim strErrorstring As String
Dim lngBuffer As Long

'Notwendige Pufferlänge holen
InternetGetLastResponseInfo lngFehlernummer, _
   strErrorstring, lngBuffer
   
'Buffer erzeugen
strErrorstring = String(lngBuffer, 0)

'Fehlertext holen
InternetGetLastResponseInfo lngFehlernummer, _
   strErrorstring, lngBuffer
   
InetError = strErrorstring
End Function
Public Function ApiStringTrim(ApiNullString As String) As String
    ApiStringTrim = Mid$(ApiNullString, 1, _
        InStr(ApiNullString, Chr(0)) - 1)
End Function

MfG
Michael 

-- 
Michael Schwimmer
 Home : http://michael-schwimmer.de
 Excel VBA ISBN 3-8273-2183-2

Relevant Pages

  • Re: Router-Abfrage
    ... Private Declare Function GetTickCount Lib "kernel32" As Long ... End Type ... Public Function HTTPReq(ByVal URL As String, ...
    (microsoft.public.de.vb)
  • Re: Datei vom Filesystem auf FTP Server kopieren
    ... > Private Declare Function InternetCloseHandle _ ... > ByRef hInet As Long _ ... > ByVal hInternetSession As Long, ... > ByVal sServerName As String, ...
    (microsoft.public.de.excel)
  • Re: Access 2007 und Registry
    ... ByVal hKey As Long) _ ... Private Declare Function api_RegCreateKeyEx _ ... ByVal lpSubKey As String, _ ...
    (microsoft.public.de.access)
  • Re: Window on top mit Focus
    ... SendMessage lngDialog, WM_SETTEXT, 0, ByVal strDateiname ... > ByVal hwnd As Long _ ... > Private Declare Function GetSubMenu _ ...
    (microsoft.public.de.excel)
  • Re: Datei vom FTP Server einlesen
    ... Private Const INTERNET_SERVICE_FTP = 1 ... ByRef hInet As Long _ ... ByVal hInternetSession As Long, _ ... ByVal sServerName As String, _ ...
    (microsoft.public.de.excel)