Macro FTP

[ipotez]

Bonjour,

J'utilise une macro FTP que voici :

Attribute VB_Name = "transfert_fich"

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()
'transfère des fichiers du disque local vers un serveur ftp (upload, mode passif)

'PARAMETRES************************
fichier = "c:\rien.doc"
login = "zaza"
mot_passe = "miaou"
rép = "/"
bin_asc=&H2 '(&H1 ascii, &H2 binaire)
mode=&H8000000 '(&H8000000 mode passif, 0 mode actif)
'**********************************

'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, "ftpperso.free.fr", 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

'nom du fichier sans le chemin
    nomfich = fichier
    Do While InStr(nomfich, "\") > 0
    nomfich = Right(nomfich, Len(nomfich) - InStr(nomfich, "\"))
    Loop

'transférer le fichier
     succès = FtpPutFile(ftp_ok, fichier, nomfich,bin_asc, 0)
    If succès Then
    résult = nomfich & " a été transféré "
    Else
    résult = nomfich & " n'a pas pu être transféré"
    End If

'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

Mon problème est que je dois donner le nom du fichier a transférer dans la partie de code suivante :

'PARAMETRES************************
fichier = "c:\rien.doc"
login = "zaza"
mot_passe = "miaou"
rép = "/"
bin_asc=&H2 '(&H1 ascii, &H2 binaire)
mode=&H8000000 '(&H8000000 mode passif, 0 mode actif)
'**********************************

Comment écrire que je souhaite qu'il transfert le fichier dont le nom est composé par la concaténation de la cellule a1 et b1 ?

Exemple : Je souhaite transférer en FTP le fichier Pierre DUPONT qui se trouve dans C:\
a1 = Pierre b1=Dupont

Merci

 

[ipotez]

Re : Macro FTP

Bon alors tout marche, c'est juste assez long parce que ne sachant pas comment éviter la répétition des macros, je me suis contenté de le mettre à la suite.

La première envoie en ftp les fichiers pdf
La seconde envoie en ftp les fichiers xls

Je suis convaincu qu'il y a moyen de formuler ces deux commandes en une seule pour gagner un peu de vitesse mais je ne sais pas faire malheureusement.

Si quelqu'un pouvait me donner un coup de pouce, ça serait super sympa.
Merci

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()
'transfère des fichiers PDF du disque local vers un serveur ftp


Chemin = "C:\******\PDF\"
Fichier = "C:\*******\PDF\" & ActiveSheet.Range("f2") & " " & ActiveSheet.Range("k2") & ".pdf"
login = "************"
mot_passe = "*******"
rép = "***********/pdf/"
bin_asc = &H2 '(&H1 ascii, &H2 binaire)
Mode = &H8000000 '(&H8000000 mode passif, 0 mode actif)
'**********************************

'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, "*******", 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

'nom du fichier sans le chemin
    nomfich = Fichier
    Do While InStr(nomfich, "\") > 0
    nomfich = Right(nomfich, Len(nomfich) - InStr(nomfich, "\"))
    Loop

'transférer le fichier
     succès = FtpPutFile(ftp_ok, Fichier, nomfich, bin_asc, 0)
    If succès Then
    résult = nomfich & " est en ligne sur ******.fr "
    Else
    résult = nomfich & " n'a pas pu être transféré"
    End If

'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



'transfère des fichiers XLS du disque local vers un serveur ftp

'**********************************
Chemin = "C:\**********\"
Fichier = "C:\***********\classeurs\" & ActiveSheet.Range("f2") & " " & ActiveSheet.Range("k2") & ".xlsm"
ActiveWorkbook.SaveAs "C:\**********\classeurs\" & ActiveSheet.Range("f2") & " " & ActiveSheet.Range("k2") & ".xlsm"
login = "************"
mot_passe = "*********"
rép = "**********/classeurs/"
bin_asc = &H2 '(&H1 ascii, &H2 binaire)
Mode = &H8000000 '(&H8000000 mode passif, 0 mode actif)

'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, "*********", 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

'nom du fichier sans le chemin
    nomfich = Fichier
    Do While InStr(nomfich, "\") > 0
    nomfich = Right(nomfich, Len(nomfich) - InStr(nomfich, "\"))
    Loop

'transférer le fichier
     succès = FtpPutFile(ftp_ok, Fichier, nomfich, bin_asc, 0)
    If succès Then
    résult = nomfich & " est en ligne sur **********.fr "
    Else
    résult = nomfich & " n'a pas pu être transféré"
    End If

'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