Sujet Précédent Sujet Suivant

Dezipper un dossier depuis une macro VBA Excel ?

Fermé
ylgue Messages postés 5 Date d'inscription jeudi 27 juillet 2017 Statut Membre Dernière intervention 1 août 2017 - Modifié le 27 juil. 2017 à 12:40
ylgue Messages postés 5 Date d'inscription jeudi 27 juillet 2017 Statut Membre Dernière intervention 1 août 2017 - 1 août 2017 à 11:07
Salut tout le monde,

Je débute en VBA et j'aurais souhaité comprendre une macro qui dezip un fichier pour récuperer mon fichier .exe depuis une macro VBA.

J'ai trouver ca sur Internet mai impossible de comprendre son fonctionnement :/ 


Option Explicit 
 
Sub Unzip() 
Dim FSO As Object 
Dim oApp As Object 
Dim DossierZip As Variant 
Dim DossierDezip As Variant
Dim UserAct As String

    UserAct = Environ("Username")
     
    DossierZip = "C:\Users\" & UserAct & "\Downloads\test.zip"
    DossierDezip = "C:\XXX\Test"
 
    Set FSO = CreateObject("Scripting.FileSystemObject" ) 
    If FSO.FolderExists(DossierDezip) Then 
        FSO.DeleteFile DossierDezip & "\*.*", True 
        FSO.DeleteFolder DossierDezip & "\*.*", True 
    End If 
    Set FSO = Nothing 
 
    If CreationDossier(DossierDezip) Then 
 
        Set oApp = CreateObject("Shell.Application" ) 
        oApp.Namespace(DossierDezip).CopyHere oApp.Namespace(DossierZip).items 
        Set oApp = Nothing 
 
        Application.StatusBar = "Les fichiers Dézippés se trouvent dans : " & DossierDezip 
    End If 
End Sub


Puis 


Private Function CreationDossier(ByVal sChemin As String) As Boolean 
Dim i As Integer, sTmp As String, Ar() As String 
    If InStr(sChemin, ":" ) = 0 Then 
        Ar = Split(CurDir & "\" & sChemin, "\" ) 
    Else 
        Ar = Split(sChemin, "\" ) 
    End If 
 
    sTmp = Ar(0) 
    ChDrive sTmp 
 
    For i = LBound(Ar) + 1 To UBound(Ar) 
        If Ar(i) <> "" Then 
            sTmp = sTmp & "\" & Ar(i) 
            On Error Resume Next 
            MkDir sTmp 
            On Error GoTo 0 
        End If 
    Next i 
 
    If Dir(sChemin, vbDirectory) = vbNullString Then 
        CreationDossier = False 
    Else 
        CreationDossier = True 
    End If 
End Function



Si quelqu'un pourrait me le commenter pour une meilleure explication :)

Je vous en remercie d'avance !
A voir également:

1 réponse

Réponse 1 / 1
thev Messages postés 1855 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 13 mai 2024 683
27 juil. 2017 à 19:12
ci-dessous exemple de code pour dézipper des fichiers se trouvant dans un répertoire donné 

Sub Unzip()
    
    Dim FSO As Object
    Dim ShApp As Object
    Dim dossier As Object, fichier As Object
    Dim répertoire_zip As String, répertoire_unzip As Variant

    '// Assignation des répertoires
    répertoire_zip = "D:\Docs\zip"
    répertoire_unzip = "D:\Docs\unzip"
    
    '// Assignation Application Shell et Objet gestion de fichiers
    Set ShApp = CreateObject("Shell.Application")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    '// Balayage des fichiers .zip se trouvant dans le répertoire et dézippage
    Set dossier = FSO.GetFolder(répertoire_zip)
    For Each fichier In dossier.Files
        If FSO.GetExtensionName(fichier.Path) = "zip" Then
            ShApp.Namespace(répertoire_unzip).CopyHere ShApp.Namespace(fichier.Path).items
        End If
    Next
    
End Sub
1
ylgue Messages postés 5 Date d'inscription jeudi 27 juillet 2017 Statut Membre Dernière intervention 1 août 2017
1 août 2017 à 11:07
merci thev :)
0