Télécharger un fichier Zip sur mon Bureau avec Excel - VBA
d
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
thevPassionné d'Excel
- Messages
- 4'087
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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