Envoyer des fichiers sur un serveur à l'aide du protocole FTP

Collez le code suivant dans un module général, et appelez la fonction.

UploadToFTP strServeurFTP, strLogin, strPSW, strFolder, strPathFile, strFile

Exemple :

UploadToFTP "ftp.accesshome.be", "3stone", "password","www/fichiers/","c:/essai.txt", "essai.txt"

Attention au copier/coller qui peux induire des caractères non désirés

 

Option Compare Database
Option Explicit
'//
'// Déclarations
'//
Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21    'default for FTP servers
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4
Const MAX_PATH = 260

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

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 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 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

Const PassiveConnection As Boolean = True

Function UploadToFTP(strServerName As String, _
                     strLogin As String, _
                     strPSW As String, _
                     strFolder As String, _
                     strPathFile As String, _
                     strFile As String) As Boolean
    Dim hConnection As Long, hOpen As Long, sOrgPath As String

    'ouvrir une connexion internet
    hOpen = InternetOpen("API-Guide sample program", _
                         INTERNET_OPEN_TYPE_PRECONFIG, _
                         vbNullString, vbNullString, 0)

    'connexion au serveur FTP
    hConnection = InternetConnect(hOpen, strServerName, _
                                  INTERNET_DEFAULT_FTP_PORT, _
                                  strLogin, strPSW, _
                                  INTERNET_SERVICE_FTP, _
                                  IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)


    'définir le répertoire courant
    FtpSetCurrentDirectory hConnection, strFolder

    'uploader le fichier
    FtpPutFile hConnection, strPathFile, strFile, FTP_TRANSFER_TYPE_UNKNOWN, 0

    'fermer la connexion FTP
    InternetCloseHandle hConnection

    'fermer la connexion internet
    InternetCloseHandle hOpen

End Function

  
Télécharger la base exemple