Microsoft 365 Transfert FTP

tbft

XLDnaute Accro
Bonjour

Je souhaite réaliser une macro pour gérer des importations de fichier.
J'ai essayé avec les indications données par les posts:
https://www.excel-downloads.com/threads/liste-des-fichiers-sur-ftp.20036566/page-3#posts
https://www.excel-downloads.com/threads/bpautal.20043591/#post-20316594
J'ai essayé de télécharger le fichier : ftp://ftp-developpez.com/bidou/Cours/VBA/formationVBA.pdf
Mais raté.....
Pouvez-vous m'aider, s'il vous plait?
Pour information en ce qui concerne le FTP, je part de ..... 0
D'avance merci.
Cordialement
 
Solution
Essayez avec le code modifié ci-dessous :
( il y a juste un message supplémentaire, peut-être sera-t-il parlant ...)
VB:
Sub ListRemoteFolder(Target_Folder)
Dim HFind        As Long
    
    If Not [Dossiers].ListObject.DataBodyRange Is Nothing _
    Then [Dossiers].ListObject.DataBodyRange.Delete
    [Dossiers].Interior.ColorIndex = xlNone
    If Not [Fichiers].ListObject.DataBodyRange Is Nothing _
    Then [Fichiers].ListObject.DataBodyRange.Delete
    
    Select Case True
    Case FtpSetCurrentDirectory(HFtp, Target_Folder) = 0: MsgBox Target_Folder & " non trouvé", vbCritical
    Case Else
        Ftp.Data.cFileName = Space(MAX_PATH)
        HFind = FtpFindFirstFile(HFtp, "*.*", Ftp.Data, 0, 0)
        If HFind Then
            Do
                Buffer =...

tbft

XLDnaute Accro
Je viens de "tomber" sur le post suivant:
Je commence à avancer enfin...merci à @fanch55
Serait-il possible de me dire comment lire à la place d'écrire, s'il vous plait..???

Boulette il y a la déclaration de la fonction.
Par contre existe-t-il une fonction pour lister les répertoires et les fichiers sur un ftp???
 
Dernière édition:

fanch55

XLDnaute Barbatruc
Bonsoir,
Largement inspiré de @Staple1600 :
Inconvénient : pas de caractères "exotiques" dans le user et le password
VB:
Option Compare Text
Dim Max_SubDir
Sub Ftp_List()
Dim FtpShell As Object
Dim FtpFolder As Object
   ' Parametres Ftp ---------------------------------------------------
    Dim Serveur As String:  Serveur = "..............................................."
    Dim User As String:     User = "......................"
    Dim Pass As String:     Pass = "......................."
    Dim Port As String:     Port = "21"
    Dim Dossier As String:  Dossier = ".........................."
   ' Parametres Ftp ---------------------------------------------------
    Worksheets("ShellList").Select: Cells.Clear
    Max_SubDir = 1
    Set FtpShell = CreateObject("Shell.Application")
    Set FtpFolder = FtpShell.Namespace("ftp://" & User & ":" & Pass & "@" & Serveur & ":" & Port & "/" & Dossier)
    [A1] = FtpFolder
        Recur_Ftp FtpFolder, 2, 1, 1
    Columns.AutoFit
    Set FtpShell = Nothing
End Sub
Sub Recur_Ftp(FtpFolder, L%, C%, SubDir%)
Dim Fich As Object
    For Each Fich In FtpFolder.items
        If Not Fich.Name Like "*recycle*" Then
            With Cells(L, C)
                .Value = Fich.Name
                .AddComment CStr(FtpFolder.GetDetailsOf(Fich, 3)) 'DateLastModified
                If Fich.IsFolder Then
                    .Interior.Color = 16247773
                    .HorizontalAlignment = xlRight
                    If SubDir <= Max_SubDir Then
                        Recur_Ftp Fich.getfolder, L, C + 1, SubDir + 1
                        L = L - 1
                    End If
                End If
            End With
            L = L + 1
        End If
    Next
End Sub
 

tbft

XLDnaute Accro
merci pour aide
J'étais partie sur l'autre solution mais je coince sur l'instruction qui permettrai de lister les fichiers.
VB:
' Searches the specified directory of the given FTP session. File and directory entries are returned to the application in the WIN32_FIND_DATA structure.
Private Declare PtrSafe Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As WIN32_FIND_DATA, ByVal lpFindFileData As String, ByVal dwFlags As Long, ByVal dwContext As Long)
J'ai déclaré aussi les types suivants:
VB:
Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Public 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
  cAlternate    As String * 14
End Type

Pouvez-vous me dire pourquoi sa ne marche pas, s'il vous plait?
A défaut de pourvoir mettre le fichier, je partage le code....
Code:
Option Explicit
Option Base 1

Const FTP_Adresse = "........"
Const FTP_Login = "....."
Const FTP_Mot_de_Passe = "....."

Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Public 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
  cAlternate    As String * 14
End Type

'aide sur les fonction
'   Private Declare PtrSafe Function --> https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/declare-statement?f1url=%3FappId%3DDev11IDEF1%26l%3Dfr-FR%26k%3Dk(vblr6.chm1008781);k(TargetFrameworkMoniker-Office.Version%3Dv16)%26rd%3Dtrue
'   wininet.dll  ----------------------> https://docs.microsoft.com/en-us/windows/win32/wininet/ftp-sessions


' 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
'
' Close the Internet object
Private Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
'
' 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
'
' Searches the specified directory of the given FTP session. File and directory entries are returned to the application in the WIN32_FIND_DATA structure.
Private Declare PtrSafe Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As WIN32_FIND_DATA, ByVal lpFindFileData As String, ByVal dwFlags As Long, ByVal dwContext As Long)
'

Private Sub test()
Dim HwndConnect As Long
Dim HwndOpen As Long, MyFile
Dim toto As WIN32_FIND_DATA

  ' Initialisation de la connexion FTP
  HwndOpen = InternetOpen("connexionFTP", 0, vbNullString, vbNullString, 0)
 
  ' Connexion au serveur FTP
  HwndConnect = InternetConnect(HwndOpen, FTP_Adresse, 21, FTP_Login, FTP_Mot_de_Passe, 1, 0, 0)
 
  MyFile = FtpFindFirstFile(HwndOpen, toto, vbNullString, 0, 0)
 
  ' Fermeture des connexions
  InternetCloseHandle HwndConnect
  InternetCloseHandle HwndOpen

End Sub
 

fanch55

XLDnaute Barbatruc
Un classeur avec Inet :
Renseigner les infos sur la feuille et faire Connect.
Vous pouvez par la suite faire un double-click sur un des dossiers affichés pour le développer
 

Pièces jointes

  • FtpInet.xlsm
    41.7 KB · Affichages: 9

tbft

XLDnaute Accro
Bonsoir @fanch55
J'essaye de faire fonctionner votre macro : j'ai le même soucis avec la mienne.
La fonction "HFind = FtpFindFirstFile(HFtp, "*.*", Ftp.Data, 0, 0)" me renvoi 00000000000000000 GRRRRRRRRRR
Il y aurait une solution pour voir pourquoi tant de haine???
Parce que je sais qu'il y a des fichiers à lister !!!!
 

fanch55

XLDnaute Barbatruc
Essayez avec le code modifié ci-dessous :
( il y a juste un message supplémentaire, peut-être sera-t-il parlant ...)
VB:
Sub ListRemoteFolder(Target_Folder)
Dim HFind        As Long
    
    If Not [Dossiers].ListObject.DataBodyRange Is Nothing _
    Then [Dossiers].ListObject.DataBodyRange.Delete
    [Dossiers].Interior.ColorIndex = xlNone
    If Not [Fichiers].ListObject.DataBodyRange Is Nothing _
    Then [Fichiers].ListObject.DataBodyRange.Delete
    
    Select Case True
    Case FtpSetCurrentDirectory(HFtp, Target_Folder) = 0: MsgBox Target_Folder & " non trouvé", vbCritical
    Case Else
        Ftp.Data.cFileName = Space(MAX_PATH)
        HFind = FtpFindFirstFile(HFtp, "*.*", Ftp.Data, 0, 0)
        If HFind Then
            Do
                Buffer = Split(Ftp.Data.cFileName, vbNullChar)(0)
                If Ftp.Data.dwFileAttributes And vbDirectory Then
                    [Dossiers].ListObject.ListRows.Add
                    [Dossiers].Rows([Dossiers].ListObject.ListRows.Count).Value = Buffer & "/"
                Else
                    [Fichiers].ListObject.ListRows.Add
                    [Fichiers].Rows([Fichiers].ListObject.ListRows.Count).Value = Buffer
                End If
            Loop While InternetFindNextFile(HFind, Ftp.Data)
            With [Dossiers].ListObject.Sort
                .SortFields.Clear
                .SortFields.Add Key:=Range("Dossiers[[#All],[Dossiers]]"), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            With [Fichiers].ListObject.Sort
                .SortFields.Clear
                .SortFields.Add Key:=Range("Fichiers[[#All],[Fichiers]]"), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            If Target_Folder <> "/" Then
                [Dossiers].ListObject.ListRows.Add 1
                [Dossiers].Rows(1) = "../"
                [Dossiers].Rows(1).Interior.Color = vbGreen
            End If
        Else
            MsgBox GetErr(Err.LastDllError), vbCritical
        End If


        Columns("E").AutoFit
     End Select

    InternetCloseHandle HFind

End Sub
 

fanch55

XLDnaute Barbatruc
Sinon, installez Filezilla Client et vérifiez la même opération qui pose problème

1630358558574.png
 

tbft

XLDnaute Accro
Bonjour @fanch55
Merci pour vos réponses.
En ce qui concerne Fillezilla, c'est le logiciel que j'utilise pour les transferts "manuels".
C'est avec lui que je me connecte sur le site pour faire les opérations de transfert.
Il n'y a pas de soucis : la connexion se fait bien et la liste de répertoires et de fichiers s'affichent bien.
Je vais essayé votre sub et je vous tiens au courant....
 

tbft

XLDnaute Accro
@fanch55
Votre code me renvoi Erreur 12002 "The request has timed out."....
alors que le mien renvoi Erreur 12018 "Type of handle supplied is incorrect for this operation."

Correction :
j'avais tapé : MyFile = FtpFindFirstFile(HwndOpen, "*.csv", toto, 0, 0)
au lieu de : MyFile = FtpFindFirstFile(HwndConnect,"*.csv", toto, 0, 0)

du coup je tombe sur l'erreur time out
alors que sur fillezilla la réponse quasi instantanée...

Re correction
VB:
  top_deb = Now()
 
  MyFile = FtpFindFirstFile(HwndConnect, "*.csv", toto, 0, 0)
 ' MyFile = FtpFindFirstFile(HwndConnect, vbNull, toto, 0, 0)
 top_fin = Now()
 duree = top_fin - top_deb
valeur de duree 32s....
 
Dernière édition:

fanch55

XLDnaute Barbatruc
Ces Api me ramène au temps où je codais en VB6 ( cela fait plus de 20 ans ) .

Ci-joint le même type de classeur mais sans les Api, avec Shell et prise en compte des caractères "exotiques" dans le User et le password .
 

Pièces jointes

  • FtpShell.xlsm
    26.9 KB · Affichages: 3

Discussions similaires

Réponses
2
Affichages
785

Membres actuellement en ligne

Statistiques des forums

Discussions
312 215
Messages
2 086 330
Membres
103 188
dernier inscrit
evebar