Dezippé dossier et sous dossier

Le 24/12/2021 à 13:08

Bonjour le forum !

Je tente de réaliser une macro qui dezippe un dossier et ses sous dossiers choisi par l'utilisateur, dans un nouveau dossier, encore choisi par l'utilisateur.

Mon problème ici est qu'après avoir choisi le dossier source (.zip) et le dossier cible, ma macro plante sur le parcours de fichier. (ligne : For each fichier in dossier_source.Files)

Erreur d'exécution 424 : Objet requis

Sub Unzip()

    Dim FSO As FileSystemObject
    Dim ShApp As Shell32.IShellDispatch4
    Dim dossier_source As Variant, dossier_cible As Variant, fichier As Variant

    'Choix des dossier source et cible
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Zip Files", "*.zip"
        .Show

        dossier_source = .SelectedItems(1) & "\"
    End With

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show

        dossier_cible = .SelectedItems(1) & "\"
    End With

    '// Assignation Application Shell et Objet gestion de fichiers
    Set ShApp = New Shell32.Shell
    Set FSO = New FileSystemObject

    '// Balayage des fichiers .zip se trouvant dans le répertoire et dézippage
    For Each fichier In dossier_source.Files
        If FSO.GetExtensionName(fichier.path) = ".zip" Then
            ShApp.Namespace(dossier_cible).CopyHere ShApp.Namespace(fichier.path).Items
        End If
    Next

End Sub

Je pense donc que mon erreur vient de la déclaration de ma variable fichier (je pense...), mais je n'arrive pas à trouver de solution. J'ai tenté fichier as variant comme fichier as object mais aucun des deux ne marche.

Merci d'avance pour votre aide !

Le 24/12/2021 à 14:23

bonjour,

essaie ainsi, (non testé)

Sub Unzip()

    Dim FSO As FileSystemObject
    Dim ShApp As Shell32.IShellDispatch4
    Dim dossier_source As Variant, dossier_cible As Variant, fichier As Variant

    'Choix des dossier source et cible
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Zip Files", "*.zip"
        .Show

        dossier_source = .SelectedItems(1) & "\"
    End With

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show

        dossier_cible = .SelectedItems(1) & "\"
    End With

    '// Assignation Application Shell et Objet gestion de fichiers
    Set ShApp = New Shell32.Shell
    Set FSO = New FileSystemObject
    Set dossier_source = FSO.getfolder(dossier_source) '<------------------------
    '// Balayage des fichiers .zip se trouvant dans le répertoire et dézippage
    For Each fichier In dossier_source.Files
        If FSO.GetExtensionName(fichier.Path) = ".zip" Then
            ShApp.Namespace(dossier_cible).CopyHere ShApp.Namespace(fichier.Path).Items
        End If
    Next

End Sub
Le 24/12/2021 à 14:41

Bonjour,

merci pour la réponse.

J'ai testé et j'ai une erreur sur la ligne : Set dossier_source = FSO.GetFolder(dossier_source)

Erreur 76 : chemin d'accès introuvable

Le 24/12/2021 à 15:11

bonjour,

je n'avais pas fait attention à ces instructions (qui ne sélectionne pas un dossier, mais un fichier)

'Choix des dossier source et cible
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Zip Files", "*.zip"
        .Show

        dossier_source = .SelectedItems(1) & "\"
    End With

remplace par

'Choix des dossier source et cible
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show

        dossier_source = .SelectedItems(1) & "\"
    End With
Le 24/12/2021 à 15:16

oui c'est aussi ce que je me suis dit, mais avec cette méthode, les dossiers zip n'apparaissent pas, et je ne peux pas appliquer la méthode .Filters.Add. Il existe peut-être une méthode équivalente mais je n'ai pas trouvé...

Le 24/12/2021 à 15:21

re-bonjour,

le dossier à sélectionner est celui qui contient tes fichiers ".zip", pas un fichier ".zip"

Ta macro parcourt ensuite la liste des fichiers qui sont dans ce dossier, sélectionne ceux qui ont une extension .zip et les dézippe et met le résultat dans ton dossier cible.

si tu ne souhaites pas sélectionner un répertoire mais directement un fichier "."zip" à dezipper, ceci devrait le faire. (non testé)

Sub Unzip()

    Dim FSO As FileSystemObject
    Dim ShApp As Shell32.IShellDispatch4
    Dim dossier_source As Variant, dossier_cible As Variant, fichier As Variant

    'Choix des dossier source et cible
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Zip Files", "*.zip"
        .Show

        fichier = .SelectedItems(1)
    End With

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show

        dossier_cible = .SelectedItems(1) & "\"
    End With

    '// Assignation Application Shell et Objet gestion de fichiers
    Set ShApp = New Shell32.Shell
    Set FSO = New FileSystemObject
    ShApp.Namespace(dossier_cible).CopyHere ShApp.Namespace(fichier).Items

End Sub
Le 24/12/2021 à 15:34

Bonjour H2SO4

J'aimerai pouvoir tester ta solution mais j'ai deux erreurs,

La première erreur sur la ligne

Dim ShApp As Shell32.IShellDispatch4 (j'ai voulu mettre Shell.IShellDispatch4 en commentaire, c'est la qu'intervient la deuxième erreur)

La deuxième sur la ligne

Set ShApp = New Shell32.Shell

Quelle référence en VBA pour Excel365 Pro? Je ne sais pas comment solutionner ce problème.

Merci pour ton aide à Emoh1998

Le 24/12/2021 à 15:47

Bonjour scraper,

Je répondais à Emoh1998, son code ne fonctionne pas tel quel chez moi, mais je n'ai pas touché à la définition de son application shell car apparemment c'est ce qui fonctionne chez lui.

ce code devrait fonctionner chez toi.

Sub Unzip()

    Dim FSO As Object
    Dim ShApp As Object
    Dim dossier_source As Variant, dossier_cible As Variant, fichier As Variant

    'Choix du fichier source et dossier cible
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Zip Files", "*.zip"
        .Show

        fichier = .SelectedItems(1)
    End With

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show

        dossier_cible = .SelectedItems(1) & "\"
    End With

    '// Assignation Application Shell et Objet gestion de fichiers
    Set ShApp = CreateObject("shell.application")
    Set FSO = CreateObject("scripting.filesystemobject")
    ShApp.Namespace(dossier_cible).CopyHere ShApp.Namespace(fichier).Items

End Sub
Le 25/12/2021 à 14:07

Bonjour et Joyeux Noël à tous,

Voici un essai avec possibilité de mise à la corbeille des zip une fois le dézippage réalisé :

Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Type SHFILEOPSTRUCT
'https://docs.microsoft.com/fr-fr/windows/win32/api/shellapi/ns-shellapi-shfileopstructa
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type

Sub GoDezip()
Dim vSrcZip As Variant, dossier_cible As Variant
With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Sélectionnez le dossier à dézipper"
    .Filters.Clear
    .Filters.Add "Zip Files", "*.zip"
    .Show
    If .SelectedItems.Count > 0 Then vSrcZip = .SelectedItems(1) Else GoTo fin
End With
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Choisissez le dossier de destination du contenu du zip"
    .Show
    If .SelectedItems.Count > 0 Then dossier_cible = .SelectedItems(1) & "\" Else GoTo fin
End With
Unzip vSrcZip, dossier_cible 'dézippe le zip choisi
RecycleFile cstr(vSrcZip)
UnZipByKeyWord dossier_cible, , True 'dézippe tous les zip contenus dans le répertoire hôte du contenu dézippé à l'instant
Exit Sub
fin:
MsgBox "Opération annulée", vbInformation
End Sub

Sub RecycleFile(sFile As String)
'Chip Pearson, mpep / https://forum.excel-pratique.com/excel/suppresion-d-un-fichier-vers-la-corbeille-t5449.html
'https://www.developpez.net/forums/d322793/logiciels/microsoft-office/excel/macros-vba-excel/vba-excel-recycle-bin-corbeille/
Const FO_DELETE = &H3
Const FOF_ALLOWUNDO = &H40
Dim FileOperation As SHFILEOPSTRUCT
Dim lReturn As Long
With FileOperation
    .wFunc = FO_DELETE
    .pFrom = sFile
    .fFlags = FOF_ALLOWUNDO
End With
lReturn = SHFileOperation(FileOperation)
End Sub

Sub Unzip(ZipPath As Variant, DestinationPath As Variant)
'https://excel-malin.com/codes-sources-vba/vba-zip-compresser-et-decompresser-fichiers/
'https://docs.microsoft.com/fr-fr/windows/win32/shell/folder-copyhere
'Le répertoire de destination doit terminer par "\"
With CreateObject("Shell.Application")
    .Namespace(DestinationPath).CopyHere .Namespace(ZipPath).Items, 16 '16 pour remplacer tout
End With
End Sub

Sub UnZipByKeyWord(ParentPath, Optional Keyword As String, Optional Recycle As Boolean)
Dim sFilename$
sFilename = Dir(ParentPath & "\*" & Keyword & ".zip")
Do While sFilename <> ""
    Unzip ParentPath & "\" & sFilename, ParentPath
    If Recycle Then RecycleFile CStr(ParentPath & "\" & sFilename)
    sFilename = Dir
Loop
End Sub

Cdlt,

Le 28/12/2021 à 11:52

Bonjour à tous,

Merci 3GB, ta solution fonctionne chez moi.

Je suis confronté au même soucis que Emoh1998 à la différence près que je souhaiterais pouvoir dézipper tous les dossiers .zip contenu dans un dossier qui lui n'est pas zippé.

Quelqu'un aurait-il une idée de la manière où je pourrais exécuter cela ?

Merci d'avance pour votre aide :)

Le 29/12/2021 à 11:20

Bonjour x--ben,

C'est ce que fait la macro UnZipByKeyWord, elle permet de dézipper tous les zip d'un dossier en fonction d'un mot-clé.

Il est possible de créer un dossier également pour chaque zip dézippé :

Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Type SHFILEOPSTRUCT
'https://docs.microsoft.com/fr-fr/windows/win32/api/shellapi/ns-shellapi-shfileopstructa
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type

Sub GoDezip()
Dim vZip As Variant
vZip = GetFolderPath(Title:="Sélectionnez le dossier à dézipper")
if vZip = "" then msgbox "Opération annulée", 16: exit sub
UnZipByKeyWord ParentPath:=vZip, Recycle:=True, CreateFolder:=True
End Sub

Sub RecycleFile(sFile As String)
'Chip Pearson, mpep / https://forum.excel-pratique.com/excel/suppresion-d-un-fichier-vers-la-corbeille-t5449.html
'https://www.developpez.net/forums/d322793/logiciels/microsoft-office/excel/macros-vba-excel/vba-excel-recycle-bin-corbeille/
Const FO_DELETE = &H3
Const FOF_ALLOWUNDO = &H40
Dim FileOperation As SHFILEOPSTRUCT
Dim lReturn As Long
With FileOperation
    .wFunc = FO_DELETE
    .pFrom = sFile
    .fFlags = FOF_ALLOWUNDO
End With
lReturn = SHFileOperation(FileOperation)
End Sub

function GetFolderPath(optional DefaultPath as string, optional ButtonName as string, optional Title as string) as string
With Application.FileDialog(msoFileDialogFolderPicker)
    .initialfilename = DefaultPath
    .buttonname = ButtonName
    .Title = Title
    .Show
    If .SelectedItems.Count > 0 Then GetFolderPath = .SelectedItems(1)
End With
end function

Sub Unzip(ZipPath As Variant, DestinationPath As Variant)
'https://excel-malin.com/codes-sources-vba/vba-zip-compresser-et-decompresser-fichiers/
'https://docs.microsoft.com/fr-fr/windows/win32/shell/folder-copyhere
'Le répertoire de destination doit terminer par "\"
With CreateObject("Shell.Application")
    .Namespace(DestinationPath).CopyHere .Namespace(ZipPath).Items, 16 '16 pour remplacer tout
End With
End Sub

Sub UnZipByKeyWord(ParentPath, Optional Keyword As String, Optional Recycle As Boolean, optional CreateFolder as boolean)
Dim sFilename$, sNewRep$
sFilename = Dir(ParentPath & "\*" & Keyword & ".zip")
Do While sFilename <> ""
    if CreateFolder then
        sNewRep = replace(ParentPath & "\" & sFilename, ".zip", "")
        do while dir(sNewRep, vbdirectory) <> ""
            sNewRep = sNewrep & " (1)"
        loop
        mkdir sNewRep
        Unzip ParentPath & "\" & sFilename, sNewRep
    else
        Unzip ParentPath & "\" & sFilename, ParentPath
    end if
    If Recycle Then RecycleFile CStr(ParentPath & "\" & sFilename)
    sFilename = Dir
Loop
End Sub

Cdlt,

Le 03/01/2022 à 11:40

Bonjour tout le monde !

Bonne année !

Excusez-moi pour le délai, je reviens d'une semaine de congés..

Je modifie le message que je viens de poster car je viens de résoudre mon problème

Merci H2so4, je n'avais effectivement pas compris qu'il fallait que les dossier zip à décompresser soit contenu dans un dossier sans extension, et non dans un dossier lui aussi compressé.

Je poste mon code si cela peut être utile pour certains :

Sub Unzip()

    Dim FSO As FileSystemObject
    Dim ShApp As Shell32.Shell
    Dim dossier_source As Variant, dossier_cible As Variant, fichier As Object

    'Choix des dossier source et cible
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show

        dossier_source = .SelectedItems(1) & "\"
    End With

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show

        dossier_cible = .SelectedItems(1) & "\"
    End With

    '// Assignation Application Shell et Objet gestion de fichiers
    Set ShApp = New Shell32.Shell
    Set FSO = New FileSystemObject

    Set dossier_source = FSO.GetFolder(dossier_source) '<------------------------

    '// Balayage des fichiers .zip se trouvant dans le répertoire et dézippage
    For Each fichier In dossier_source.Files
        If FSO.GetExtensionName(fichier.path) = "zip" Then
            ShApp.Namespace(dossier_cible).CopyHere ShApp.Namespace(fichier.path).Items
        End If
    Next

End Sub

Merci encore pour votre aide !

Le 03/01/2022 à 11:48

bonjour,

que contient ton répertoire source ? combien de fichiers .zip ?

Le 03/01/2022 à 11:54

Bonjour,

Plus de problème ! mon erreur venait de la ligne :

If FSO.GetExtensionName(fichier.path) = "zip" Then

où j'avais laissé le point dans le ".zip" (équivalent à dire une extension ..zip je suppose, ce qui n'a effectivement pas trop de sens).

Je viens d'essayer et tout fonctionne très bien !

A tout hasard, dans le projet sur lequel je travaille, le dossier source sera toujours un zip. Est-il possible de sélectionner un dossier source avec extension zip et non dossier sans extension contenant tout les dossier a décompresser ? Cela permettrait de gagner un peu de temps...

Le 03/01/2022 à 12:34

bonjour,

les répertoires (dossiers) n'ont pas d'extension, mais il est naturellement possible de faire une sélection sur base du nom du répertoire.

Rechercher des sujets similaires à "dezippe dossier"