Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 vba Download ftp

Bens7

XLDnaute Impliqué
Bonjour a tous !!
Alros voila j'ai trouver sur le net (je suis novice) 2 code ( voir ici bas ) pour Uploader sur mon ftp :

Un qui Upload un fichier spécifique
Un autre qui Upload tout les fichiers contenu dans un dossier spécifique

p.s c'est 2 codes marche a la perfection et après plusieurs jour de recherche je les gardes précieusement !

Mon problème est que j'ai besoin de l'effet inverse en Download !
Un qui Download un fichier spécifique
Un autre qui Download tout les fichiers contenu dans un dossier spécifique

bien sur je ne sais pas du tout comment faire ! loll mais je souhaite absolument a garder le même code ... tout ceux que j'ai trouver sur le net ne fonctionne pas...

merci pour votre aide !!
Voici le code d'upload d'un fichier :
Code:
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 subuploadftpfichier()
'transfère des fichiers du disque local vers un serveur ftp (upload, mode passif)
Dim Start As Single

'PARAMETRES************************
Fichier = ActiveWorkbook.Path & "\XLSM\" & UserForm1.TextBox16 & ".xlsm"

login = "xxxxxxxxxxxxxx"
mot_passe = "xxxxxxxxxxxxxxx"
 rép = "/web/XLSM"
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, "ltez.ftp.infomaniak.com", 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 FTP "
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é sur le serveur FTP "
Else
résult = nomfich & " n'a pas pu être transféré sur le serveur FTP"
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

et voici le code d'upload d'un contenue de dossier :
Code:
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

'a ajouter pour le Chemin complet
Public Dossierup

Sub uploadftpdossier()
    'Entrer le nom du Chemin ici
     chemin = "D:\XXXXXXXXXX\RESEAUX\HTML\FTP" 'Nom du Chemin
    NF = Dir(chemin & "\*.*")
    Do While NF <> ""
        N = N + 1
        'Cells(N, 1) = ActiveCell & "\" & NF
        Dossierup = chemin & "\" & NF
       
        'Lance l'upload
        Transfertdossftp
        NF = Dir    ' suivant
    Loop

    'msgbox ferme seul
CreateObject("Wscript.shell").popup "HTML > FTP A JOUR", 1, "MISE A JOUR", vbExclamation

End Sub


Sub Transfertdossftp()
'transfère des fichiers du disque local vers un serveur ftp (upload, mode passif)
Dim Start As Single

'PARAMETRES************************
Fichier = Dossierup
login = "XXXXXXXXXXXXXXX"
mot_passe = "XXXXXXXXXXXXXXX"
rép = "/web/HTML"
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, "ltez.ftp.infomaniak.com", 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 FTP "
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

Voila peux pas faire plus clair merci encore pour vos lumieres !!
 

Discussions similaires

  • Résolu(e)
Microsoft 365 32 ou 64 bits
Réponses
46
Affichages
2 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…