ACCESS VBA Créer une connexion FTP

**Décibel** · 05/09/2012, 00h08

Bonsoir,

Je cherche comment créer une connexion FTP et lister les fichiers d'un dossier.
J'ai trouvé du code pour uploader ou downloader mais pas pour ce que je souhaite...

Merci de votre aide !

**Décibel** · 05/09/2012, 00h46

J'ai trouvé comment créer le FTP, comment uploader ou downloader, mais pas comment lister les fichiers dans le dossier...

Help...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
'-------------------
'Déclaration des API
'-------------------
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
 
 
'Envoi et réception d'un fichier 
Private Sub Commande27_Click() 
Dim HwndConnect As Long 
Dim HwndOpen As Long 
'Ouvre internet 
HwndOpen = InternetOpen("SiteWeb", 0, vbNullString, vbNullString, 0) 
'Connection au site ftp 
HwndConnect = InternetConnect(HwndOpen, "<ftp>", <port>, _
  "<username>", "<password>", 1, 0, 0) 
'positionnement du curseur dans le répertoire 
FtpSetCurrentDirectory HwndConnect, "page_web/documents" 
 'Téléchargement de test.txt 
FtpGetFile HwndConnect, "test.txt", "C:\WINDOWS\Bureau\test.txt", _
  False, 0, &H0, 0
 
FtpPutFile HwndConnect, "C:\windows\bureau\test.txt", "shwin.txt", &H0, 0 
'Envoi du fichier test.txt et renomme en shwin.txt un coup rend sur le serveur 
 
InternetCloseHandle HwndConnect 'Ferme la connection 
InternetCloseHandle HwndOpen 'Ferme internet 
End Sub

**FreeAccess** · 05/09/2012, 06h09

Bonjour,

Peut-être en essayant d'adapter le code de ce post...

FTP : lister répertoire - récupérer et supprimer fichiers

**Décibel** · 05/09/2012, 10h30

Whaouuuu !!!
Le code bug un peu partout...
Et je n'y comprend pas grand chose...
C'est assez étrange on trouve des dizaines de fonctions sur le net pour uploader et dowloader, mais faire juste une liste de fichiers d'un dossier nada...
Soit c'est trop simple soit trop compliqué, mais là je n'en sais rien...

Help please...

**Décibel** · 05/09/2012, 18h35

Bon, ben je me suis relevé les manches et suis arrivé à faire une chose...

Il permet de lire et afficher la liste des fichiers d'un dossier et de les Downloader sur un PC comme une sorte de FTP, les sites sont mis dans une table.
Le code de la table est plus bas...

Voila le code complet VBA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
Option Compare Database
Option Explicit
 
'-------------------
'Déclaration des API
'-------------------
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
Private Declare Function FtpFindFirstFile Lib "wininet" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetFindNextFile Lib "wininet" Alias "InternetFindNextFileA" (ByVal hFtpSession As Long, lpFindFileData As WIN32_FIND_DATA) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (ByRef lpdwError As Long, ByVal lpszErrorBuffer As String, ByRef lpdwErrorBufferLength As Long) As Boolean
 
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const INTERNET_DEFAULT_FTP_PORT = 21
Private Const INTERNET_SERVICE_FTP = 1
 
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
Private Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Private Const MAX_PATH = 260
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
 
 
 
Function ListeFichiers(serveur As String, Utilisateur As String, MotDePasse As String, Optional Dossier As String = "/", Optional Fichiers As String = "*.*") As Collection
  ' Liste les fichiers et dossiers du dossier FTP passé en paramètres
  Dim pData As WIN32_FIND_DATA
  Dim hInternet As Long, hFTP As Long, hPremier As Long, hSuivant As Long
  Dim pFichiers As New Collection
  Dim NomFichier As String
 
  pData.cFileName = String(MAX_PATH, 0)
 
  hInternet = InternetOpen("", 1, vbNullString, vbNullString, 0)
  If hInternet <> 0 Then
    hFTP = InternetConnect(hInternet, serveur, 21, Utilisateur, MotDePasse, 1, &H8000000, 0) '&H8000000 134217728
    If hFTP <> 0 Then
      If FtpSetCurrentDirectory(hFTP, Dossier) Then
        hPremier = FtpFindFirstFile(hFTP, Fichiers, pData, 0, 0)
        If hPremier <> 0 Then
          NomFichier = Left(pData.cFileName, _
            InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
          pFichiers.Add NomFichier & ";" & pData.dwFileAttributes
          hSuivant = 1
          Do While hSuivant <> 0
            pData.cFileName = String(MAX_PATH, 0)
            hSuivant = InternetFindNextFile(hPremier, pData)
            If hSuivant <> 0 Then
              NomFichier = Left(pData.cFileName, _
                InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
              pFichiers.Add NomFichier & ";" & pData.dwFileAttributes
 
            End If
          Loop
        End If
      End If
    End If
  End If
  Set ListeFichiers = pFichiers
 
  InternetCloseHandle hSuivant
  InternetCloseHandle hPremier
  InternetCloseHandle hFTP
  InternetCloseHandle hInternet
End Function
 
 
Sub DownLoadSites()
 
' on se connecte à la base
' on liste les sites
 
        Dim db As Database
        Dim rs1 As Recordset
        Set db = CurrentDb
 
        Dim pFichiers As Collection
        Dim SiteFTP As String, Utilisateur As String, MotDePasse As String
        Dim I As Long
        Dim HwndConnect As Long
        Dim HwndOpen As Long
        Dim Nomfic As String, NomFicLocal As String
        Dim RepDistant As String
        Dim DossierSOVsurC As String
 
 
        Set rs1 = db.OpenRecordset("Select * from Tbl_sites")
        If rs1.RecordCount = 0 Then GoTo Suite
        'boucle sur les sites
        While Not rs1.EOF
 
 
                ' Télécharge les fichiers d'un répertoire
                ' Utilise la fonction ListeFichiers pour obtenir la liste des fichiers concernés
                ' Attention : sous Access97 : nécessite une fonction de substitution ReplaceT (http://access.developpez.com/faq/?page=ManipDATA#ReplAcc97)
                '
 
                ' paramètres FTP
                  SiteFTP = rs1!FTPsite
                  Utilisateur = rs1!Usersite
                  MotDePasse = rs1!PWsite
                  RepDistant = rs1!Dossier_image1 & "/"
                  DossierSOVsurC = rs1!Dossier_sov_image1
 
 
 
                ' sélectionner des fichiers dans la collection PFichiers
                  Set pFichiers = ListeFichiers(SiteFTP, Utilisateur, MotDePasse, RepDistant, "*.*")  ', "*.xml")  ' possibilité de filtrer les fichiers ici (ex : *.xml"
                    ' MsgBox " le nombre de fichiers est de " & pFichiers.Count
 
                'Ouvre internet
                HwndOpen = InternetOpen(SiteFTP, 0, vbNullString, vbNullString, 0)
                If HwndOpen = 0 Then
                   MsgBox "connection internet impossible"
                   Exit Sub
               End If
                'Connection au site ftp
                HwndConnect = InternetConnect(HwndOpen, SiteFTP, 21, Utilisateur, MotDePasse, 1, &H8000000, 0)  ' 134217728 ou 0 pour contourner les pb de parefeu
                '&H8000000  '(&H8000000 mode passif, 0 mode actif)
                If HwndConnect = 0 Then
                   MsgBox "connection  impossible"
                   'Exit Sub
               End If
                'positionnement du curseur dans le répertoire
                FtpSetCurrentDirectory HwndConnect, RepDistant
                If FtpSetCurrentDirectory(HwndConnect, RepDistant) = 0 Then
                   MsgBox "impossible de trouver le répertoire distant " & RepDistant
                   'Exit Sub
               End If
 
 
                ' Download des fichiers sélectionnés
                  For I = 1 To pFichiers.Count
                    ' Si besoin affichage des fichier dans la fenêtre de debogage (CTRL G) on peut ici mettre les fichier dans une table par exemple pour les afficher ultérieurement
                    'Debug.Print pFichiers(I)
                    ' les fichiers se termine par ";128" les dossiers par ";16"
                    If Right(pFichiers(I), 4) = ";128" Then
                     ' download du fichier
                         Nomfic = Replace(pFichiers(I), ";128", "") 'autres versions
                         NomFicLocal = "D:\" & rs1!NomSite & "\" & DossierSOVsurC & "\" & Nomfic
                     ' test si fichier déjà sur le disque dur du PC pour ne pas le retélécharger une nouvelle fois
                        If Not FicExist(NomFicLocal) Then 'download du fichier
                            FtpGetFile HwndConnect, Nomfic, NomFicLocal, False, 0, &H0, 0
                        End If
                    Else
                     ' c'est un répertoire
                    End If
                  Next I
 
            'fermer les pointeurs, ménage
            InternetCloseHandle HwndConnect
            InternetCloseHandle HwndOpen
 
 
        rs1.MoveNext
        Wend
Suite:
        rs1.Close
        db.Close
        MsgBox "Téléchargement des fichiers ...terminé"
 
End Sub

Pour la table qui permet d'enregistrer les sites voici ses champs
Ref_site NomSite URLsite FTPsite Usersite PWsite sov_php Dossier_image1 Dossier_sov_image1

Il est possible de créer plusieurs dossiers image pour gérer la complexité de vos sites...

**Décibel** · 05/09/2012, 18h46

Au passage, l'affichage de votre site sur IE9 bug au niveau des zones de codes, il y a plein de lignes et les caractères sont déformés...

ACCESS VBA Créer une connexion FTP [AC-2010]

VBA Access

Discussions similaires

Partager

Partager