ftp versand

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: ftp versand

29.11.2003 09:24:41

Bernd Kiehl

AW: ftp versand

29.11.2003 14:10:24

jhaustein

Probier mal das...

29.11.2003 14:22:54

Ramses

Hallo

Das ist zwar nicht von mir, aber den Autor weiss ich auch nicht.
Den Code in ein Modul kopieren. Gestartet wird das ganze mit CallFTP

Gruss Rainer

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

Code eingefügt mit Syntaxhighlighter 1.16

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread