Public Function FTPupload()
    pSocket = ftpConnect("ftp.larsbehrmann.de", "benutzername", "passwort")
    If pSocket > 0 Then
    ftpSetBinary (pSocket)
    ftpPutFile pSocket, 0, "c:\meldung\status.htm", "status.htm"
    End If
    ftpQuit (pSocket)
End Function

If it's stupid but it works, it isn't stupid.

If it's stupid but it works, it isn't stupid.

If it's stupid but it works, it isn't stupid.

'Verbindung zum FTP-Server 
' aufbauen*********************************************************************
' ****************
FtpServer = ftpConnect("xxxxxxxxxxx", "xxxxxxxxxxxx", "xxxxxxxxxxxx")
If FtpServer = 1 Then
    FRM_MAIN.L_Stat.Caption = "Zum FTP-Server verbunden!"
    FRM_MAIN.L_Stat.Caption = ftpGetLastStatusMsg
Else
    FRM_MAIN.L_Stat.Caption = "Verbindung zum FTP-Server fehlgeschlagen!"
    FRM_MAIN.L_Stat.Caption = ftpGetLastStatusMsg
End If
'Call ftpSetBinary(FtpServer)
'******************************************************************************
' *****************************************
 
'Daten 
' senden***********************************************************************
' ************************************
Set gRCS = gDTB.OpenRecordset("SELECT * FROM updatedata WHERE UpdateDate =" & _
  "DateValue('" & Date & "');")
With gRCS
    Do While Not .EOF
        LpaF = .Fields("OriginalFile").Value
        FtpF = .Fields("UpdatePath").Value & "/" & .Fields("FileName").Value

        FileSend = FtpPutFile(CLng(FtpServer), 0, CStr(FtpF), CStr(LpaF))

        FRM_MAIN.L_Stat.Caption = ftpGetLastStatusMsg
    .MoveNext
    Loop
End With
'******************************************************************************
' *****************************************
Call ftpQuit(FtpServer)
FRM_MAIN.L_Stat.Caption = ftpGetLastStatusMsg

If it's stupid but it works, it isn't stupid.

If it's stupid but it works, it isn't stupid.

Public Declare Function ftpConnect Lib "vbarchiv.dll" _
                                  (sServer As String, _
                                   sUser As String, _
                                   sPW As String) As Long
 
Public Declare Function ftpPutFile Lib "vbarchiv.dll" _
                            (ByVal hSocket As Long, _
                             ByRef sServer As String, _
                             ByVal hStatus As Long, _
                                   remoteFile As String, _
                                   localFile As String) As Long
 
Public Declare Function ftpGetLastStatusCode Lib "vbarchiv.dll" _
                            () As Long
 
Public Declare Sub ftpSetAscii Lib "vbarchiv.dll" _
                            (ByVal hSocket As Long)
 
Public Declare Sub ftpQuit Lib "vbarchiv.dll" _
                            (ByVal hSocket As Long)
 
Sub FTPUpload()
 
'Lädt eine Text-Datei auf den Server. /public/... ist der Pfad ab dem Root
 
Dim pSocket As Long
Dim res As Long
Const cMyServer = "ftp.guarda-cuolms.ch"
 
pSocket = ftpConnect(cMyServer, "benutzername", "passwort")
If pSocket > 0 Then
  'OK: Verbindung geöffnet
  ftpSetAscii (pSocket)    
  res = ftpGetLastStatusCode()
  If res = 200 Then
    'OK
    res = ftpPutFile(pSocket, cMyServer, 0, "/public/index.html", _
      "C:\MyProject\index.html")
    If res=1 Then
      'OK
      ftpQuit (pSocket)
      res = ftpGetLastStatusCode()
      If res = 221 Then
        'OK
      ElseIf res = 0 Then
        'nach ca. 45s
        MsgBox "Problem bei FTP-Upload (ftpQuit): " & pSocket & "(keine" & _
          "Verbindung zu Server)"
      Else
        MsgBox "Problem bei FTP-Upload (ftpQuit)" & pSocket & "(unbekanntes" & _
          "Problem)"
      End If
    ElseIf res = 0 Then
      'nach ca. 120s
      MsgBox "Problem bei FTP-Upload (ftpPutFile): " & res & "(keine Verbindung" & _
        "zu Server)"
    Else
      MsgBox "Problem bei FTP-Upload (ftpPutFile): " & res & "(unbekanntes" & _
        "Problem)"
    End If
  ElseIf res = 0 Then
    'Timeout nach 60s
    MsgBox "Problem bei FTP-Upload (ftpSetAscii): " & res & "(keine Verbindung" & _
      "zu Server)"
  Else
    MsgBox "Problem bei FTP-Upload (ftpSetAscii): " & res & "(unbekanntes" & _
      "Problem)"
  End If
ElseIf pSocket = -2147483648# Then
  'nach ca 15s
  MsgBox "Problem bei FTP-Upload FTP-Upload (ftpConnect): " & pSocket & "(keine" & _
    "Verbindung zu Server)"
Else
  MsgBox "Problem bei FTP-Upload (ftpConnect)" & pSocket & "(unbekanntes" & _
    "Problem)"
End If
 
End Sub

Public Function FTPupload_htm()
    pSocket = ftpConnect("feuerwehr-barsbuettel.de", "user", "passwort")
    If pSocket > 0 Then
    ftpSetBinary (pSocket)
    ftpChangeDir pSocket, "public_html/status"
    ftpPutFile pSocket, "feuerwehr-barsbuettel.de", 0, "status.htm", _
      "c:\meldung\status.htm"
    End If
    ftpQuit (pSocket)
End Function

If it's stupid but it works, it isn't stupid.

If it's stupid but it works, it isn't stupid.

Public Function FTPupload_htm()
    pSocket = ftpConnect("feuerwehr-barsbuettel.de", "user", "pass")
    MsgBox pSocket
    MsgBox ftpCurDir(pSocket)
    If pSocket > 0 Then
    ftpSetBinary (pSocket)
    ftpChangeDir pSocket, "public_html/status"
    ftpPutFile pSocket, "feuerwehr-barsbuettel.de", 0, "status.htm", _
      "c:\meldung\status.htm"
    End If
    ftpQuit (pSocket)
End Function

If it's stupid but it works, it isn't stupid.

If it's stupid but it works, it isn't stupid.

Zitat:

Hast Du auch mal die LastStatusMsg ausgelesen? -> Wie muß ich dass machen? Der Router mit Firewall wird vermutlich die Verbindung nicht erlauben.