John Ben

Voici un code VBA qui fonctionne parfaitement pour envoyer un fichier Excel sur un serveur FTP

Option Explicit
Public Login As String, Mdp As String, NumFic As String
'Déclaration des API Windows pour permettre la récupération du fichier sur le serveur FTP
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 FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hConnect As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Long, _
ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
ByRef dwContext As Long) 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


Public Sub ImportFTP(FicELO As string)
On Error GoTo Err_Sub
  Dim HwndConnect As Long
  Dim HwndOpen As Long, MyFile
  ' On récupère l'adresse IP dans les CGR
  Dim SiteFTP
  ' Définir l'adresse IP - ICI
  SiteFTP = "0.0.0.0"  ' Lance l'ouverture du site ftp
  HwndOpen = InternetOpen("ftp://" & SiteFTP & "/travail", 0, vbNullString, vbNullString, 0)
  'Connection au site ftp
  HwndConnect = InternetConnect(HwndOpen, SiteFTP, 21, Login, Mdp, 1, 0, 0)
  'positionnement du curseur dans le répertoire
  FtpSetCurrentDirectory HwndConnect, "/travail"
  ' Téléchargement du fichier ELO
  Dim Rep
  Rep = FtpGetFile(HwndConnect, FicELO, VPathFileName, False, 0, &H0, 0)
  ' Vérifier que le fichier a bien été téléchargé
  If Rep = False Then
    InternetCloseHandle HwndConnect 'Ferme la connection
    InternetCloseHandle HwndOpen 'Ferme internet
    MsgBox "Impossible d'importer le fichier : " & FicELO & vbCrLf _
      & "Arrêt de la macro !"
    End
  End If
  ' Ferme le handle de connection puis celui d'Internet
  InternetCloseHandle HwndConnect
  InternetCloseHandle HwndOpen

  Exit Sub

Err_Sub:
  MsgBox "Une erreur c'est produite, arrêt de la macro"
  InternetCloseHandle HwndConnect 'Ferme la connection
  InternetCloseHandle HwndOpen 'Ferme internet
  FlgErr = True
  End
End Sub

Attribute VB_Name = "transfert_fich"



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
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
Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias _
     "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, _
     ByVal lpszDirectory As String) As Boolean
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
Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer


Sub ftp()
'transfère des fichiers du disque local vers un serveur ftp (upload, mode passif)

'PARAMETRES************************
fichier = "c:\rien.doc"
login = "zaza"
mot_passe = "miaou"
rép = "/"
bin_asc=&H2 '(&H1 ascii, &H2 binaire)
mode=&H8000000 '(&H8000000 mode passif, 0 mode actif)
'**********************************

'lancer le transfert
internet_ok = InternetOpen("PutFtpFile", 1, "", "", 0)
    If internet_ok = 0 Then
    MsgBox "connection internet impossible"
    Exit Sub
    End If
ftp_ok = InternetConnect(internet_ok, "ftpperso.free.fr", 21, login, mot_passe, 1, mode, 0)
    If ftp_ok = 0 Then
    MsgBox "connection  impossible"
    Exit Sub
    End If
sélect_rép = FtpSetCurrentDirectory(ftp_ok, rép)
    If sélect_rép = 0 Then
    MsgBox "impossible de trouver le répertoire "
    Exit Sub
    End If

'nom du fichier sans le chemin
    nomfich = fichier
    Do While InStr(nomfich, "\") > 0
    nomfich = Right(nomfich, Len(nomfich) - InStr(nomfich, "\"))
    Loop

'transférer le fichier
     succès = FtpPutFile(ftp_ok, fichier, nomfich,bin_asc, 0)
    If succès Then
    résult = nomfich & " a été transféré "
    Else
    résult = nomfich & " n'a pas pu être transféré"
    End If

'fermer les pointeurs, ménage
    InternetCloseHandle ftp_ok
    InternetCloseHandle internet_ok

'annoncer le résultat de l'opération
    If résult <> "" Then
    MsgBox résult
    Else
    MsgBox "aucun fichier transféré"
    End If

End Sub