Option Explicit
 
' Für Fehlerauswertung...
Dim bError As Boolean
Private Sub Inet1_StateChanged(ByVal State As Integer)
If State = icError Then
    bError = True
  End If
End Sub
 
Private Sub Inet1_StateChanged(ByVal State As Integer)
If State = icError Then
    bError = True
  End If
End Sub
 
 
Private Sub Form_Load()
Dim sLocalFile As String
Dim sRemoteFile As String
 
bError = False
With Inet1
  .AccessType = icUseDefault
On Error GoTo hErr
 
 
  ' Protokoll auf FTP setzen und Port 21 verwenden
  .Protocol = icFTP
  .RemotePort = 21
 
  ' Name des FTP-Servers, zu dem verbunden werden soll
  .URL = "ftp.TEST-TEST.com"
 
'############################################################
  ' Benutzer-Authentifizierung
  .UserName = "TEST"
  .Password = "TEST"
  '.UserName = "TEST"
  '.Password = "TEST"
 
  ' Datei, die hochgeladen werden soll (lokal)
  sLocalFile = "C:\Programme\internet\caesarout.dat"
  If Dir(sLocalFile) = "" Then
     Err.Raise vbObjectError + 1050
End If
  ' Verzeichnis und Dateiname der Zieldatei auf dem FTP-Server
  sRemoteFile = "/upload/test.dat"
'#############################################################
 
' Upload ausführen
  .Execute , "PUT " & sLocalFile & " " & sRemoteFile
 
  'MsgBox "Übertragung läuft"
  ' Warten, bis Vorgang abgeschlossen
  Do While .StillExecuting And Not bError
    DoEvents
  Loop
 
  If Not bError Then
  ' Upload war erfolgreich
  'MsgBox "Die Übertragung ist abgeschlossen"
  Open "C:\Programme\internet\okupload.txt" For Output As #1
Close #1
  Else
    ' Fehler
    'MsgBox "Fehler beim Upload! Bitte überprüfen Sie Ihre Internetverbindung" 
    ' & vbCrLf & _
      "ResponseCode: " & .ResponseCode & vbCrLf & _
      "ResponseInfo: " & .ResponseInfo
hErr:
'MsgBox "Fehler beim Upload! Bitte überprüfen Sie Ihre Internetverbindung" & 
' vbCrLf & _
      "ResponseCode: " & .ResponseCode & vbCrLf & _
      "ResponseInfo: " & .ResponseInfo
Open "C:\Programme\internet\errorupload.txt" For Output As #1
Close #1
  End If
  End With
Unload Me
End Sub