Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Macro d'upload sur FTP

6 réponses
Avatar
cliffburton57
Utilisateur/programeur VBA moyen
Windows XP PRO SP2

Bonjour à tous,
Je souhaiterai uploader un fichier de mon pc sur un serveur ftp via une
macros excel apres action sur un bouton de controle.

Je reste disponible pour de plus amples informations.
Merci à Tous.

6 réponses

Avatar
Daniel
Bonjour.
Va sur la page :
http://www.excelabo.net/moteurs/compteclic.php?nom½f-transfertftp
et récupère le fichier.
Il faut remplacer "Get" par "put" dans le code. Je pense que c'est tout.
Cordialement.
Daniel
"cliffburton57" a écrit dans le
message de news:
Utilisateur/programeur VBA moyen
Windows XP PRO SP2

Bonjour à tous,
Je souhaiterai uploader un fichier de mon pc sur un serveur ftp via une
macros excel apres action sur un bouton de controle.

Je reste disponible pour de plus amples informations.
Merci à Tous.


Avatar
Misange
ou encore, presque au même endroit
http://www.excelabo.net/excel/reseau.php#transfertFTP" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.excelabo.net/excel/reseau.php#transfertFTP

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

Utilisateur/programeur VBA moyen
Windows XP PRO SP2

Bonjour à tous,
Je souhaiterai uploader un fichier de mon pc sur un serveur ftp via une
macros excel apres action sur un bouton de controle.

Je reste disponible pour de plus amples informations.
Merci à Tous.


Avatar
cliffburton57
Bonjour et surtout Merci a vous pour ces reponses rapides.
Cependant, il me reste un petit probleme à résoudre.
J'ai modifié légérement le code trouvé sur:
http://www.excelabo.net/excel/reseau.php#transfertFTP

ca me donne ca:
Sub ExportFtp()

Dim InternetOK
Dim FtpOK
Dim FtpServeur
Dim FtpLogin
Dim FtpPass
Dim DossierLocal
Dim DossierDistant
Dim Internet_OK
Dim FTP_OK
Dim Select_DossierDistant
Dim res

DossierLocal = Pathroot
DossierDistant = Range("bdlt!e18").Value
FtpServeur = Range("bdlt!e15").Value
FtpLogin = Range("bdlt!e16").Value
FtpPass = Range("bdlt!e17").Value

'Vérifier la connection à internet
InternetOK = InternetOpen("PutFtpFile", 1, "", "", 0)
If InternetOK = 0 Then
MsgBox "connection internet impossible"
Exit Sub
End If
Const INTERNET_FLAG_PASSIVE = &H8000000
'Vérifier l'accès ftp
FtpOK = InternetConnect(InternetOK, FtpServeur, 21, FtpLogin, FtpPass, 1,
INTERNET_FLAG_PASSIVE, 0)
If FtpOK = 0 Then
MsgBox "connection FTP impossible"
Exit Sub
End If


'vérifier le dossier distant
Select_DossierDistant = FtpSetCurrentDirectory(FtpOK, DossierDistant)
If Select_DossierDistant = 0 Then
MsgBox "impossible de trouver le répertoire distant "
Exit Sub
End If

result = ""
erreur = ""

'adresses du ou des fichiers à transférer
FichierLocal = DossierLocal & Nom_Fichier & ".txt"
FichierDistant = Nom_Fichier & ".txt"

'transférer les fichiers
Const FTP_TRANSFER_TYPE_BINARY = &H2
'mode passif proxy
succès = FtpPutFile(FtpOK, FichierLocal, FichierDistant,
FTP_TRANSFER_TYPE_BINARY, 0)
texte = "Transfert" & FichierDistant
If succès Then
result = "Les fichiers ont été transférés "
Else
erreur = "Tous les fichiers n'ont pas été tranférés"
End If

'fermer les pointeurs, ménage
InternetCloseHandle FTP_OK
InternetCloseHandle Internet_OK


End Sub

le probleme c'est que quand le fichier existe déja sur le ftp, il ne le
remplace pas.il garde l'ancien.
J'ai essayé de trouver en vain.
je suppose qu'il faut faire une recherche sur le FTP puis faire un kill mais
bon ....
MERCI D'AVANCE A TOUS !!!!
Avatar
Misange
Bonjour,

J'utilise cette macro et je ne rencontre pas ce problème, le nouveau
fichier écrase bien l'ancien.
mais tu peux essayer ceci :

Sub PetitMenage()
'élimine le fichiers créé lors de la session sur le serveur
'mettre en commentaire les lignes de cette macro pour faire des tests de
transfert
Result = ""
Const INTERNET_FLAG_PASSIVE = &H8000000
Internet_OK = InternetOpen("PutFtpFile", 1, "", "", 0)
FTP_OK = InternetConnect(Internet_OK, FtpServeur, 21, FtpLogin, FtpPass,
1, INTERNET_FLAG_PASSIVE, 0)
Select_DossierDistant = FtpSetCurrentDirectory(FTP_OK, DossierDistant)

supp = FtpDeleteFile(FTP_OK, "nomduficher.extension")
If supp Then
res = "Fichier supprimé"
Else
res = "Echec de la suppression du fichier"
End If


'fermer les pointeurs, ménage
InternetCloseHandle FTP_OK
InternetCloseHandle Internet_OK

End Sub

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

Bonjour et surtout Merci a vous pour ces reponses rapides.
Cependant, il me reste un petit probleme à résoudre.
J'ai modifié légérement le code trouvé sur:
http://www.excelabo.net/excel/reseau.php#transfertFTP

ca me donne ca:
Sub ExportFtp()

Dim InternetOK
Dim FtpOK
Dim FtpServeur
Dim FtpLogin
Dim FtpPass
Dim DossierLocal
Dim DossierDistant
Dim Internet_OK
Dim FTP_OK
Dim Select_DossierDistant
Dim res

DossierLocal = Pathroot
DossierDistant = Range("bdlt!e18").Value
FtpServeur = Range("bdlt!e15").Value
FtpLogin = Range("bdlt!e16").Value
FtpPass = Range("bdlt!e17").Value

'Vérifier la connection à internet
InternetOK = InternetOpen("PutFtpFile", 1, "", "", 0)
If InternetOK = 0 Then
MsgBox "connection internet impossible"
Exit Sub
End If
Const INTERNET_FLAG_PASSIVE = &H8000000
'Vérifier l'accès ftp
FtpOK = InternetConnect(InternetOK, FtpServeur, 21, FtpLogin, FtpPass, 1,
INTERNET_FLAG_PASSIVE, 0)
If FtpOK = 0 Then
MsgBox "connection FTP impossible"
Exit Sub
End If


'vérifier le dossier distant
Select_DossierDistant = FtpSetCurrentDirectory(FtpOK, DossierDistant)
If Select_DossierDistant = 0 Then
MsgBox "impossible de trouver le répertoire distant "
Exit Sub
End If

result = ""
erreur = ""

'adresses du ou des fichiers à transférer
FichierLocal = DossierLocal & Nom_Fichier & ".txt"
FichierDistant = Nom_Fichier & ".txt"

'transférer les fichiers
Const FTP_TRANSFER_TYPE_BINARY = &H2
'mode passif proxy
succès = FtpPutFile(FtpOK, FichierLocal, FichierDistant,
FTP_TRANSFER_TYPE_BINARY, 0)
texte = "Transfert" & FichierDistant
If succès Then
result = "Les fichiers ont été transférés "
Else
erreur = "Tous les fichiers n'ont pas été tranférés"
End If

'fermer les pointeurs, ménage
InternetCloseHandle FTP_OK
InternetCloseHandle Internet_OK


End Sub

le probleme c'est que quand le fichier existe déja sur le ftp, il ne le
remplace pas.il garde l'ancien.
J'ai essayé de trouver en vain.
je suppose qu'il faut faire une recherche sur le FTP puis faire un kill mais
bon ....
MERCI D'AVANCE A TOUS !!!!



Avatar
cliffburton57
Merci Misange pour la rapidité de ta reponse.
Il me reste un probleme, je n'ai pas la fonction FtpDeleteFile de declarer
donc ca ne marche pas.Je ne sais pas comment la declarer .
Merci.
@+


Bonjour,

J'utilise cette macro et je ne rencontre pas ce problème, le nouveau
fichier écrase bien l'ancien.
mais tu peux essayer ceci :

Sub PetitMenage()
'élimine le fichiers créé lors de la session sur le serveur
'mettre en commentaire les lignes de cette macro pour faire des tests de
transfert
Result = ""
Const INTERNET_FLAG_PASSIVE = &H8000000
Internet_OK = InternetOpen("PutFtpFile", 1, "", "", 0)
FTP_OK = InternetConnect(Internet_OK, FtpServeur, 21, FtpLogin, FtpPass,
1, INTERNET_FLAG_PASSIVE, 0)
Select_DossierDistant = FtpSetCurrentDirectory(FTP_OK, DossierDistant)

supp = FtpDeleteFile(FTP_OK, "nomduficher.extension")
If supp Then
res = "Fichier supprimé"
Else
res = "Echec de la suppression du fichier"
End If


'fermer les pointeurs, ménage
InternetCloseHandle FTP_OK
InternetCloseHandle Internet_OK

End Sub

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

Bonjour et surtout Merci a vous pour ces reponses rapides.
Cependant, il me reste un petit probleme à résoudre.
J'ai modifié légérement le code trouvé sur:
http://www.excelabo.net/excel/reseau.php#transfertFTP

ca me donne ca:
Sub ExportFtp()

Dim InternetOK
Dim FtpOK
Dim FtpServeur
Dim FtpLogin
Dim FtpPass
Dim DossierLocal
Dim DossierDistant
Dim Internet_OK
Dim FTP_OK
Dim Select_DossierDistant
Dim res

DossierLocal = Pathroot
DossierDistant = Range("bdlt!e18").Value
FtpServeur = Range("bdlt!e15").Value
FtpLogin = Range("bdlt!e16").Value
FtpPass = Range("bdlt!e17").Value

'Vérifier la connection à internet
InternetOK = InternetOpen("PutFtpFile", 1, "", "", 0)
If InternetOK = 0 Then
MsgBox "connection internet impossible"
Exit Sub
End If
Const INTERNET_FLAG_PASSIVE = &H8000000
'Vérifier l'accès ftp
FtpOK = InternetConnect(InternetOK, FtpServeur, 21, FtpLogin, FtpPass, 1,
INTERNET_FLAG_PASSIVE, 0)
If FtpOK = 0 Then
MsgBox "connection FTP impossible"
Exit Sub
End If


'vérifier le dossier distant
Select_DossierDistant = FtpSetCurrentDirectory(FtpOK, DossierDistant)
If Select_DossierDistant = 0 Then
MsgBox "impossible de trouver le répertoire distant "
Exit Sub
End If

result = ""
erreur = ""

'adresses du ou des fichiers à transférer
FichierLocal = DossierLocal & Nom_Fichier & ".txt"
FichierDistant = Nom_Fichier & ".txt"

'transférer les fichiers
Const FTP_TRANSFER_TYPE_BINARY = &H2
'mode passif proxy
succès = FtpPutFile(FtpOK, FichierLocal, FichierDistant,
FTP_TRANSFER_TYPE_BINARY, 0)
texte = "Transfert" & FichierDistant
If succès Then
result = "Les fichiers ont été transférés "
Else
erreur = "Tous les fichiers n'ont pas été tranférés"
End If

'fermer les pointeurs, ménage
InternetCloseHandle FTP_OK
InternetCloseHandle Internet_OK


End Sub

le probleme c'est que quand le fichier existe déja sur le ftp, il ne le
remplace pas.il garde l'ancien.
J'ai essayé de trouver en vain.
je suppose qu'il faut faire une recherche sur le FTP puis faire un kill mais
bon ....
MERCI D'AVANCE A TOUS !!!!






Avatar
Misange
voici toutes les déclarations nécessaires dont le FTPOdelete

Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As
FILETIME, lpSystemTime As SYSTEMTIME) As Long
Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As
FILETIME, lpLocalFileTime As FILETIME) 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 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 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 SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As
Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As
Long, ByVal lpBuffer As String) As Long
Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As
Long) As Integer
Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean

Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
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 * 300
cAlternate As String * 14
End Type
Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
'**********************fin declaration FTP************************

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://xlwiki.free.fr/wiki
http://www.excelabo.net" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.excelabo.net

Merci Misange pour la rapidité de ta reponse.
Il me reste un probleme, je n'ai pas la fonction FtpDeleteFile de declarer
donc ca ne marche pas.Je ne sais pas comment la declarer .
Merci.
@+


Bonjour,

J'utilise cette macro et je ne rencontre pas ce problème, le nouveau
fichier écrase bien l'ancien.
mais tu peux essayer ceci :

Sub PetitMenage()
'élimine le fichiers créé lors de la session sur le serveur
'mettre en commentaire les lignes de cette macro pour faire des tests de
transfert
Result = ""
Const INTERNET_FLAG_PASSIVE = &H8000000
Internet_OK = InternetOpen("PutFtpFile", 1, "", "", 0)
FTP_OK = InternetConnect(Internet_OK, FtpServeur, 21, FtpLogin, FtpPass,
1, INTERNET_FLAG_PASSIVE, 0)
Select_DossierDistant = FtpSetCurrentDirectory(FTP_OK, DossierDistant)

supp = FtpDeleteFile(FTP_OK, "nomduficher.extension")
If supp Then
res = "Fichier supprimé"
Else
res = "Echec de la suppression du fichier"
End If


'fermer les pointeurs, ménage
InternetCloseHandle FTP_OK
InternetCloseHandle Internet_OK

End Sub

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://xlwiki.free.fr/wiki
http://www.excelabo.net" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.excelabo.net

Bonjour et surtout Merci a vous pour ces reponses rapides.
Cependant, il me reste un petit probleme à résoudre.
J'ai modifié légérement le code trouvé sur:
http://www.excelabo.net" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.excelabo.net/excel/reseau.php#transfertFTP

ca me donne ca:
Sub ExportFtp()

Dim InternetOK
Dim FtpOK
Dim FtpServeur
Dim FtpLogin
Dim FtpPass
Dim DossierLocal
Dim DossierDistant
Dim Internet_OK
Dim FTP_OK
Dim Select_DossierDistant
Dim res

DossierLocal = Pathroot
DossierDistant = Range("bdlt!e18").Value
FtpServeur = Range("bdlt!e15").Value
FtpLogin = Range("bdlt!e16").Value
FtpPass = Range("bdlt!e17").Value

'Vérifier la connection à internet
InternetOK = InternetOpen("PutFtpFile", 1, "", "", 0)
If InternetOK = 0 Then
MsgBox "connection internet impossible"
Exit Sub
End If
Const INTERNET_FLAG_PASSIVE = &H8000000
'Vérifier l'accès ftp
FtpOK = InternetConnect(InternetOK, FtpServeur, 21, FtpLogin, FtpPass, 1,
INTERNET_FLAG_PASSIVE, 0)
If FtpOK = 0 Then
MsgBox "connection FTP impossible"
Exit Sub
End If


'vérifier le dossier distant
Select_DossierDistant = FtpSetCurrentDirectory(FtpOK, DossierDistant)
If Select_DossierDistant = 0 Then
MsgBox "impossible de trouver le répertoire distant "
Exit Sub
End If

result = ""
erreur = ""

'adresses du ou des fichiers à transférer
FichierLocal = DossierLocal & Nom_Fichier & ".txt"
FichierDistant = Nom_Fichier & ".txt"

'transférer les fichiers
Const FTP_TRANSFER_TYPE_BINARY = &H2
'mode passif proxy
succès = FtpPutFile(FtpOK, FichierLocal, FichierDistant,
FTP_TRANSFER_TYPE_BINARY, 0)
texte = "Transfert" & FichierDistant
If succès Then
result = "Les fichiers ont été transférés "
Else
erreur = "Tous les fichiers n'ont pas été tranférés"
End If

'fermer les pointeurs, ménage
InternetCloseHandle FTP_OK
InternetCloseHandle Internet_OK


End Sub

le probleme c'est que quand le fichier existe déja sur le ftp, il ne le
remplace pas.il garde l'ancien.
J'ai essayé de trouver en vain.
je suppose qu'il faut faire une recherche sur le FTP puis faire un kill mais
bon ....
MERCI D'AVANCE A TOUS !!!!