Dezipper un seul fichier parmi d'autres en VBA

Bonjour à tous,

je sollicite votre aide pour un point pour lequel je ne trouve pas de solution...

Je souhaite réaliser l'extract d'un fichier qui est dans un dossier zip qui contient plusieurs autres fichiers.

L’extraction en elle même ne me pose pas de problème, j'ai trouvé pas mal de codes qui permettent d'utiliser 7zip en VBA et ça fonctionne très bien.

Ma problématique c'est que tous les codes que j'ai trouvé permettent de faire l'extract de tous les fichiers contenus dans le zip, mais aucun ne permet de cibler un seul fichier à extraire...

Le code que j'ai trouvé et qui marche bien...

Sub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant)

Dim ShellApp As Object

'Copy the files & folders from the zip into a folder
Set ShellApp = CreateObject("Shell.Application")
ShellApp.Namespace(unzipToPath).CopyHere ShellApp.Namespace(zippedFileFullName).items

End Sub

Merci à tous

Bonjour,

as tu essayé d'ajouter un numéro d'item

ShellApp.Namespace(unzipToPath).CopyHere ShellApp.Namespace(zippedFileFullName).items(2)

Je n'avais pas essayé, mais je viens de le faire et ça ne fonctionne pas, j'ai eu erreur 'Propriété ou méthode non gérée par cet objet".

re,

à tester,

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 = "C:\Users\isabelle\Documents\z_zip"  'à adapter
répertoire_unzip = "C:\Users\isabelle\Documents\z_unzip"  'à adapter

'// 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
    For Each it In ShApp.Namespace(fichier.Path).items
        n = n + 1
          'condition n à adapter
        If n = 2 Then ShApp.Namespace(répertoire_unzip).CopyHere it: Exit Sub
    Next
End If
Next
End Sub

Ca semble fonctionner

Merci beaucoup