' =====================================================================================
' source de la partie Ftp
' https://blog.lumo.fr/envoi-dun-fichier-sur-un-serveur-ftp-via-microsoft-excel.html
' =====================================================================================
' Open the Internet object
Private Declare PtrSafe 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
' Connect to the network
Private Declare PtrSafe 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
' Get a file using FTP
Private Declare PtrSafe Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, _
ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
' Send a file using FTP
Private Declare PtrSafe 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
' Close the Internet object
Private Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
Sub exportcsv()
Dim FileName As String
' Paramètres à Indiquer _____________________________
FileName = "File.csv" ' Nom du fichier csv
ftpAddr = "...................." ' Addresse du serveur Ftp cible
ftpUser = "......" ' User pour se connecter au serveur ftp
ftpPass = "......" ' Password associé au User
ftpFile = "/...../" & FileName ' Nom du fichier et de son dossier parent sur le serveur Ftp
FileName = ThisWorkbook.Path & "\" & FileName ' Nom complet du fichier à transferer
' ___________________________________________________
' On copie la feuille active sans indiquer de cible
' Excel le fait automatiquement dans un nouveau classeur et l'active
ActiveSheet.Copy
Application.CutCopyMode = False
' On sauvegarde ce classeur en Csv en mode local pour des séparateur = ";"
' et on le ferme
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs _
FileName:=FileName, FileFormat:=xlCSV, _
CreateBackup:=False, Local:=True
ActiveWindow.Close False
Application.DisplayAlerts = True
EnvoiFichierFTP ftpAddr, ftpUser, ftpPass, FileName, ftpFile
End Sub
Sub EnvoiFichierFTP(ftpAddress, _
ftpUser, _
ftpPassword, _
ftpLocalFilepath, _
ftpRemoteFilepath)
Dim HwndConnect As Long
Dim HwndOpen As Long, MyFile
' Initialisation de la connexion FTP
HwndOpen = InternetOpen("connexionFTP", 0, vbNullString, vbNullString, 0)
' Connexion au serveur FTP
HwndConnect = InternetConnect(HwndOpen, ftpAddress, 21, ftpUser, ftpPassword, 1, 0, 0)
If HwndConnect = 0 Then
MsgBox ("Une erreur est survenue lors de la connexion. Vérifiez les informations de connexion.")
InternetCloseHandle HwndConnect
InternetCloseHandle HwndOpen
Exit Sub
End If
' Envoi du fichier
HwndPut = FtpPutFile(HwndConnect, ftpLocalFilepath, ftpRemoteFilepath, &H1, 0)
If HwndPut = 0 Then
MsgBox "Une erreur est survenue lors de l'envoi du fichier. Vérifiez les emplacements des fichiers"
Else
MsgBox "Le fichier a été envoyé et reçu"
End If
' Fermeture des connexions
InternetCloseHandle HwndConnect
InternetCloseHandle HwndOpen
End Sub
