Microsoft 365 InternetOpen et FTP

Public Sub ExportFTP()


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



Dim CheminBureau As String
    
    CheminBureau = ObtenirCheminBureau()

 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 = "88.8.88.22"

Dim Login As String
Dim Mdp As String
   Login = "m"
   Mdp = "Rggt47!"


   ' Lance l'ouverture du site ftp
   HwndOpen = InternetOpen("ftp://" & SiteFTP & "/Orders", 0, vbNullString, vbNullString, 0)

   'Connection au site ftp
   HwndConnect = InternetConnect(HwndOpen, SiteFTP, 21, Login, Mdp, 1, 0, 0)

   If HwndConnect = 0 Then
        FlagFTP = 1
        InternetCloseHandle HwndConnect
        InternetCloseHandle HwndOpen
        Exit Sub
   End If

   'positionnement du curseur dans le répertoire
   FtpSetCurrentDirectory HwndConnect, "/Orders"

   FtpPutFile HwndConnect, CheminBureau & "\DEntetes_" & Worksheets("Entête").Range("A1").Value & ".csv", Fichier, &H0, 0
     FtpPutFile HwndConnect, CheminBureau & "\DMessages_" & Worksheets("Entête").Range("A1").Value & ".csv", Fichier, &H0, 0
       FtpPutFile HwndConnect, CheminBureau & "\DLignes_" & Worksheets("Entête").Range("A1").Value & ".csv", Fichier, &H0, 0
         FtpPutFile HwndConnect, CheminBureau & "\DLog_" & Worksheets("Entête").Range("A1").Value & ".csv", Fichier, &H0, 0

   ' 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