XL 2021 Upload fichier depuis Bureau

vmax67 à dit:

Bonjour à tous, je suis à la recherche d'un code pour téléverser un fichier depuis le bureau vers un site en l’occurrence Nextcloud.

J'ai bien un code pour faire l'inverse c'est à dire download depuis site vers bureau, mais j'arrive pas à le modifier dans le sens Pc vers Site.
Ci-dessous le code

Private Declare PtrSafe Function TelechargerFichierURL Lib "urlmon" _
Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long

Private Const ERROR_SUCCESS As Long = 0
Private Const BINDF_GETNEWESTVERSION As Long = &H10

Public Function TelechargerFichierInternet(SourceUrl As String, FichierLocal As String) As Boolean
TelechargerFichierInternet = TelechargerFichierURL(0&, SourceUrl, FichierLocal, BINDF_GETNEWESTVERSION, 0&) = ERROR_SUCCESS
End Function

Sub ExempleTelechargementInternet()

On Error GoTo ExempleErreur

Dim fichier_local As String
Dim fichier_internet As String

fichier_local = "C:\Bureau\Test upload.pdf" ' <-- destination locale (disque dur local, externe, clé usb,...)
fichier_internet = "https://blabla.com/index.php/s/ieMXwQaA8Yp8Ybf" ' <-- lien URL du fichier sur internet

Call TelechargerFichierInternet(fichier_local, fichier_internet)

MsgBox "Le téléchargement a réussi..."
Exit Sub

End Sub

Par avance merci pour votre aide
Vmax

Cliquez pour agrandir...

Declare PtrSafe 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 PtrSafe 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 PtrSafe Function FtpSetCurrentDirectory Lib "wininet.dll" Alias _
"FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Declare PtrSafe 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 PtrSafe 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)
Dim Start As Single
 
'PARAMETRES************************
fichier = "C:\Users\monfichier.monext"    'inscrire ici le chemin et le nom complets du fichier à télécharger'
Login = "id"   'inscrire ici l'identifiant de connection si nécessaire
mot_passe = "mypassword"    'inscrie ici le mot de passe si nécessaire'
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, "192.168.137.1", 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
'UserForm3.Label1 = résult)
'UserForm3.Show
'MsgBox résult
Else
UserForm3.Label1 = "aucun fichier transféré"
UserForm3.Show
 'MsgBox "aucun fichier transféré"
End If
End Sub

Gégé-45550 à dit:

re bonsoir,
Une autre piste :

VB:

Declare PtrSafe 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 PtrSafe 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 PtrSafe Function FtpSetCurrentDirectory Lib "wininet.dll" Alias _
"FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Declare PtrSafe 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 PtrSafe 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)
Dim Start As Single
 
'PARAMETRES************************
fichier = "C:\Users\monfichier.monext"    'inscrire ici le chemin et le nom complets du fichier à télécharger'
Login = "id"   'inscrire ici l'identifiant de connection si nécessaire
mot_passe = "mypassword"    'inscrie ici le mot de passe si nécessaire'
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, "192.168.137.1", 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
'UserForm3.Label1 = résult)
'UserForm3.Show
'MsgBox résult
Else
UserForm3.Label1 = "aucun fichier transféré"
UserForm3.Show
 'MsgBox "aucun fichier transféré"
End If
End Sub

Cordialement,

Cliquez pour agrandir...

vmax67 à dit:

Bonjour,
merci pour le retour.

en utilisant votre version je n'arrive pas sur le site internet qui d’ailleurs ne demande pas de login ni de mdp.
C'est une simple page web ou on dépose un fichier par glisser-déposer ou par sélection du fichier par l’intermédiaire de l'explorateur Windows.

Cliquez pour agrandir...

Gégé-45550 à dit:

Bonjour,
Êtes-vous sûr d'avoir bien modifié le code fourni avec la "bonne" adresse du site que vous voulez ouvrir et d'avoir laissé vides les zones destinées à l'identifiant et au MDP ?

Cliquez pour agrandir...

vmax67 à dit:

Bonjour, oui bien mis la bonne adresse du site et mdp et id vides.
Affiche toujours connexion impossible.

Cliquez pour agrandir...

Gégé-45550 à dit:

Re
La macro est destinée à du transfert FTP, si l'adresse Internet que vous utilisez est en HTTP, il est normal que ça ne marche pas.

Cliquez pour agrandir...