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()
chemin = "C:\PDF\"
login = "tutute"
mot_passe = "pouetpouet"
rép = "pdf/"
bin_asc = &H2 '(&H1 ascii, &H2 binaire)
Mode = &H8000000 '(&H8000000 mode passif, 0 mode actif)
'**********************************
Dim Tableau, I As Integer
Tableau = Array("1er SemestreDD", "1er SemestreCF", "1er SemestreAM", _
"1er SemestreFL", "1er SemestreRV", "1er SemestreYB", _
"1er SemestreOccas1", "1er SemestreOccas2", "1er SemestreOccas3", _
"1er SemestreOccas4", "1er SemestreOccas5", "2nd SemestreDD", _
"2nd SemestreCF", "2nd SemestreAM", "2nd SemestreFL", "2nd SemestreRV", _
"2nd SemestreYB", "2nd SemestreOccas1", "2nd SemestreOccas2", _
"2ndSemestreOccas3", "2nd SemestreOccas4", "2nd SemestreOccas5")
For I = LBound(Tableau) To UBound(Tableau)
'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, "crac-crac", 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
'transférer le fichier
succès = FtpPutFile(ftp_ok, chemin & Tableau(I) & ".pdf", Tableau(I) & ".pdf", bin_asc, 0)
If succès Then
résult = résult & Tableau(I) & " a été transféré " & vbCrLf
Else
résult = résult & Tableau(I) & " n'a pas pu être transféré" & vbCrLf
End If
Next I
'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