Code eingefügt mit Syntaxhighlighter 1.16
Option Explicit
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
ByVal sAgent As String, _
ByVal nAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal nFlags As Long) As Long
Private Declare Function InternetCloseHandle _
Lib "wininet.dll" (ByVal hInet As Long) As Integer
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 nService As Long, _
ByVal nFlags As Long, _
ByVal nContext As Long) As Long
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
' Kostanten
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_INVALID_PORT_NUMBER = 0
Private Const INTERNET_SERVICE_FTP = 1
' Übertragungsmodus
Public Enum eTransferType
FTP_TRANSFER_TYPE_BINARY = &H2
FTP_TRANSFER_TYPE_ASCII = &H1
End Enum
' Handles
Private hOpen As Long
Private hConnection As Long
' Verbindung zum Server herstellen
Public Function Connect(ByVal sRemoteHost As String, _
Optional ByVal sUsername As String, _
Optional ByVal sPassword As String) As Boolean
' Ist noch eine Verbindung vorhanden?
' Wenn ja, muss diese zunächst beendet werden!
If hOpen <> 0 Or hConnection <> 0 Then Disconnect
' Neue Verbindung starten
hOpen = InternetOpen("FTP", _
INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, _
vbNullString, 0)
If hOpen Then
hConnection = InternetConnect(hOpen, _
sRemoteHost, INTERNET_INVALID_PORT_NUMBER, _
sUsername, sPassword, INTERNET_SERVICE_FTP, 0, 0)
End If
Connect = (hConnection <> 0)
End Function
' Datei auf den Server hochladen
Public Function FileUpload( _
ByVal sLocalFilename As String, _
ByVal sRemoteFilename As String, _
Optional ByVal nTransferType As eTransferType = _
FTP_TRANSFER_TYPE_BINARY) As Boolean
FileUpload = FtpPutFile(hConnection, sLocalFilename, sRemoteFilename, nTransferType, 0)
End Function
' Verbindung zum Server beenden
Public Sub Disconnect()
If hConnection <> 0 Then
InternetCloseHandle hConnection
hConnection = 0
End If
If hOpen <> 0 Then
InternetCloseHandle hOpen
hOpen = 0
End If
End Sub
Sub callftp()
Dim sRemoteHost As String
Dim sUsername As String
Dim sPassword As String
Dim sLocalFile As String
Dim sRemoteFile As String
Dim Filename As String
Dim nTransferMode As eTransferType
Dim bResult As Boolean
Dim upindex As Integer
upindex = 1
'Verbindungsdaten abfragen
sRemoteHost = InputBox("Bitte geben Sie die IP oder den Namen des FTP Servers ein", "FTP - Verbindungsdaten")
sUsername = InputBox("Bitte geben Sie den Benutzernamen für den FTP - Server ein", "FTP - Verbindungsdaten")
sPassword = InputBox("Bitte geben Sie das Passwort für den FTP - Server ein", "FTP - Verbindungsdaten")
If Connect(sRemoteHost, sUsername, sPassword) Then
'Alle Files der Liste werden in der Whileschleife abgearbeitet
Do While upindex <= Cells(1, 3)
Cells(upindex + 3, 2).Select
sLocalFile = Selection.Hyperlinks.Item(1).Address
sRemoteFile = "/htdocs/" & Cells(upindex + 3, 1)
nTransferMode = FTP_TRANSFER_TYPE_ASCII
bResult = FileUpload(sLocalFile, sRemoteFile, nTransferMode)
If bResult Then
Cells(upindex + 3, 5) = "upload erfolgreich"
Else
Cells(upindex + 3, 5) = "upload nicht erfolgreich"
End If
upindex = upindex + 1
Loop
Disconnect
End If
End Sub