Microsoft 365 Valider un téléchargement en auto

philmaure

XLDnaute Impliqué
Bonjour,

Lorsque je télécharge via Edge ou Firefox je me retrouve avec une fenêtre ou il me faut cliquer sur enregistrer ou télécharger.

Dans les options de Edge et Firefox j'ai modifié l'option pour qu'il télécharge.

Existe t -il une ligne de commande WBA qui permettrait que cette fenêtre soit valider en téléchargement directement

J'ai une trentaine de téléchargement à lancer via une macro journalièrement et valider 30 fois ca devient pénible


1638284971904.png


Merci pour votre aide

Cdlt
Philmaure
 

dysorthographie

XLDnaute Accro
Bonsoir,
VB:
Public Function DownloadHTTP(ByVal URL As String, ByVal Destination As String) As Boolean
   On Error GoTo catch
   Dim oWinHTTP As Object
   Dim fic As Integer
   Dim buffer() As Byte

   Set oWinHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
   oWinHTTP.Open "GET", URL, False
   oWinHTTP.send

   If oWinHTTP.Status = 200 Then
      fic = FreeFile
      Open Destination For Binary Lock Read Write As #fic
      buffer = oWinHTTP.ResponseBody
      Put #fic, , buffer

      Close #fic
      DownloadHTTP = True
   Else
      MsgBox "Statut retourné par le service : " & oWinHTTP.Status & vbCrLf & _
             "Description : " & oWinHTTP.StatusText, vbExclamation, "DownloadHTTP()..."
   End If

finally:
   Erase buffer
   Set oWinHTTP = Nothing
   Exit Function
catch:
   MsgBox "Erreur n°" & Err.Number & vbCrLf & "Description : " & Err.Description, vbExclamation, "DownloadHTTP()..."
   Close   'ferme tous les descripteurs ouverts
  Resume finally
End Function
 

dysorthographie

XLDnaute Accro
tu dois intégrer la fonction dans un module standard; puis tu dois modifier la macro qui lance le téléchargement comme dans la sub test.
il faut que tu récupère l'URL!
VB:
Sub test()
 DownloadHTTP "https://www.excel-downloads.com/attachments/1638284971904-png.1123388/", Environ("UserProfile") & "\OneDrive\Bureau\TOTO.PNG"
End Sub
 

philmaure

XLDnaute Impliqué
merci pour la réponse, mais la fenêtre s'ouvre toujours
Pour info complémentaire, ma macro lance un lien hypertexte situé dans un fichier excel
-------------------------------------------------------------------
Sub test1()

Dim cellule As Range

Range("A2").Select

If ActiveCell.Value <> "" Then

Call lien1
Else

End If

End Sub
-------------------------------------------------------------------
Sub lien1()

Range("A2").Hyperlinks(1).Follow NewWindow:=True

Rows("2:2").Select
Selection.Delete Shift:=xlUp

Call test1

End Sub
--------------------------------------------------------------------
Cdlt
Philmaure
 

dysorthographie

XLDnaute Accro
VB:
Sub test1()

Dim cellule As Range
Do Until Range("A2") = ""

    Call lien1
Loop
End Sub
Sub lien1()

DownloadHTTP Range("A2").Hyperlinks(1).Address, "C:\Myrep\MyFicher.Extension"

Rows(2).Delete Shift:=xlUp
End Sub
Public Function DownloadHTTP(ByVal URL As String, ByVal Destination As String) As Boolean
   On Error GoTo catch
   Dim oWinHTTP As Object
   Dim fic As Integer
   Dim buffer() As Byte

   Set oWinHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
   oWinHTTP.Open "GET", URL, False
   oWinHTTP.send

   If oWinHTTP.Status = 200 Then
      fic = FreeFile
      Open Destination For Binary Lock Read Write As #fic
      buffer = oWinHTTP.ResponseBody
      Put #fic, , buffer

      Close #fic
      DownloadHTTP = True
   Else
      MsgBox "Statut retourné par le service : " & oWinHTTP.Status & vbCrLf & _
             "Description : " & oWinHTTP.StatusText, vbExclamation, "DownloadHTTP()..."
   End If

finally:
   Erase buffer
   Set oWinHTTP = Nothing
   Exit Function
catch:
   MsgBox "Erreur n°" & Err.Number & vbCrLf & "Description : " & Err.Description, vbExclamation, "DownloadHTTP()..."
   Close   'ferme to descripteurs ouverts
  Resume finally
End Function
 

philmaure

XLDnaute Impliqué
bonjour, merci pour la réponse

J'ai ce message d'erreur :
1638342288604.png


Ca pourrait venir de cette ligne (peut être)
DownloadHTTP Range("A2").Hyperlinks(1).Address, "C:\Myrep\MyFicher.Extension"


J'ai remplacé cette ligne

par : DownloadHTTP Range("A2").Hyperlinks(1).Address, "C:\Users\updy6530\Desktop\TEMP"

et du coup j'ai cette erreur
1638342504195.png


Merci pour votre aide
Cdlt
Philmaure
 

dysorthographie

XLDnaute Accro
Bonjour,
Si tu copies colles le chemin c:\etc dans l'explorateur windows tu dois ouvrir le bon répertoire s'il existe !

Pour le coup ton problème est juste lié au chemin complet du fichier de sauvegarde sur ton disck dure!
Code:
DownloadHTTP Range("A2").Hyperlinks(1).Address, Environ("UserProfile") & "\Desktop\fichier.zip"
Si tu as onedrive
Code:
Environ("UserProfile") & "\onedrive\Desktop\fichier.zip"

Pour le nom du fichier il faut,avec VBA, l'extraire de l'URL!
 
Dernière édition: