Télécharger un fichier Zip sur mon Bureau avec Excel - VBA

Bonjour,

Je débute en VBA et j'essaie de créer un script qui permet de :

  • TÉLÉCHARGER un fichier .zip sur un site web
  • DÉZIPPER ce dit fichier pour en extraire son contenu vers mon répertoire personnel

J'ai donc effectué les manipulations avec l'aide de quelques recherches sur Internet pour réaliser l'étape du Unzip.

En revanche, impossible de trouver un script qui me convient pour la seconde partie, la plupart sont pour traiter des fichiers .CSV et je n'arrive pas à les adaptés dans mon cas.

Function Download()

Dim myURL As String
myURL = "http://www.monsite.com/xxx/blabla.zip"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.send

myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile "C:\Users\XXX\blabla.zip", 2 ' 1 = no overwrite, 2 = overwrite
    oStream.Close
End If

End Function

J'ai trouver ça mais il me faudrait une méthode pour récupérer tout le dossier compresser, la si je comprends bien, je récupérerais le contenu dans un autre fichier.

En vous remerciant d'avance

Bonjour,

ci-dessous code

Option Explicit

#If VBA7 Then
    Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
    (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, _
    ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As Long
#Else
    Declare Function URLDownloadToFile 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
#End If

Sub Unzip()

    Dim WS As Object, ShApp As Object
    Dim répertoire_zip As String, répertoire_unzip As Variant, URL As String, nom_fichier As Variant
    Dim code_retour As Integer

    '// Assignation répertoires
     Set WS = CreateObject("WScript.Shell")
    répertoire_zip = WS.SpecialFolders("Desktop")
    répertoire_unzip = WS.SpecialFolders("MyDocuments")

    '// Téléchargement fichier
     URL = "http://www.monsite.com/xxx/blabla.zip"
    nom_fichier = répertoire_zip & "\" & "Save.zip"
    code_retour = URLDownloadToFile(0, URL, nom_fichier, 0, 0)
    If code_retour = 0 Then MsgBox "Téléchargement effectué" Else Exit Sub

    '// Dézippage fichier
     Set ShApp = CreateObject("Shell.Application")
    ShApp.Namespace(répertoire_unzip).CopyHere ShApp.Namespace(nom_fichier).items

End Sub

Merci beaucoup

Rechercher des sujets similaires à "telecharger fichier zip mon bureau vba"