Discussion :

[Iceabyssal]

Bonjour,

Je cherche à décompresser des fichiers zip via macro.
Tout se passe bien, sauf le fait que je ne sais pas comment obtenir le path des fichiers à décompresser.
Par exemple, un fichier A.txt contenu dans le dossier AAAA a été zippé en A.ZIP

Cette archive voit donc le path AAAA\ pour le fichier A.txt

quand je décompresse vers un dossier d:\TOTO, mon fichier se trouve alors dans d:\TOTO\AAAA\A.txt et la variable qu'il me manque est "AAAA\"

Je ne cherche surtout pas à décompresser les fichiers sans tenir compte du path, car dans ce cas, j'aurai des problèmes avec des fichiers ayant le même nom.

Voici le code de décompression :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Private Function DecompressFichierZIP(sfFichierZIP, sfRepCible)
 
    ''' Decompression d'une archive ZIP dans un dossier ==> Les noms des fichiers dezippés sont retournés dans un tableau
    Dim osa As Shell
    Dim ifNbItems As Integer
    Dim ifNbFichiers As Integer
    Dim ifBcl As Integer
    Dim sfTabListeFichiers() As String
 
    ifNbFichiers = 0
 
    Set osa = New Shell
    ifNbItems = osa.Namespace(sfFichierZIP).Items.Count
 
    ''' Copie des fichiers dans un répertoire
    If ifNbItems > 0 Then
        osa.Namespace(sfRepCible).CopyHere osa.Namespace(sfFichierZIP).Items
    End If
 
    ...

Merci de votre aide

[aalex_38]

Je ne sais pas décompresser les fichiers ZIP, mais ne pourrais-tu pas forcer l'extraction vers un repertoire de ton choix plutot que celui inidqué dans le ZIP (AAAA) ?

[Iceabyssal]

Salut aalex,

2 problèmes pour forcer l'extraction :
1) Je ne sais pas le faire avec cette méthode
2) Si tous les fichiers contenus dans les dossiers et sous dossiers de mon archives se copient au même endroit, je vais avoir des problèmes avec les fichiers ayant le même nom (Si j'ai un fichier A.txt dans le répertoire AAA et un fichier A.txt dans le répertoire BBB, il y en a forcément un qui va écraser l'autre...)

[aalex_38]

Je n'utilise pas cette fonction zip alors je vais avoir du mal à te répondre en gros je laisse la main, j'ai commencè a regarder quelquels liens mais pour l'instant rien d'intéressant a part peut être ici ?

J'essairai dès que possible de faire des tests.

[Iceabyssal]

Hélas, la Zlib n'est pas plus étoffée que mon code actuel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
ZipExtractionClass Methods
 
Extract (FolderPath[, PreservePath][, Overwrite])
 
==> FolderPath String 
==> PreservePath Boolean Optional 
==> Overwrite Boolean Optional 
 
<== Return Type is a Boolean Value

Je regarde en ce moment le contournement de ce problème par l'extraction complete de chacun de mes zip dans un dossier qui aurait un nom unique (date -heure - clé), puis de rechercher les fichiers dans les sous dossiers avec le file system afin de les réinjecter dans ma macro...

C'est juste que cela va me prendre plusieurs heures de code alors que si j'avais pu trouver cette variable, j'en aurai eu pour 3 minutes...

Enfin, la ce soir, je code une autre partie, donc si des idées brillantes avant demain...

[PMO2017]

Bonjour,

Une piste qui pourra, peut-être, vous aider.

Copiez le code suivant dans un module standard et adaptez la constante cernée par des ### à votre usage.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
'///////////////////////////////////////////////
'/// Nécessite la Library Shell32            ///
'/// Microsoft Shell Controls And Automation ///
'/// C:\WINDOWS\system32\SHELL32.dll         ///
'///////////////////////////////////////////////
 
'### Constante du dossier et son chemin à adapter ###
Const MON_DOSSIER = "C:\A.zip"
'####################################################
 
Sub PropertiesFile()
Dim ShellApp As Shell32.Shell
Dim Fichier As Shell32.FolderItem
Dim Dossier As Shell32.Folder
Dim i&
Dim j&
Dim T()
Dim S As Worksheet
Dim R As Range
Set ShellApp = CreateObject("Shell.Application")
Set Dossier = ShellApp.Namespace(MON_DOSSIER)
ReDim T(1 To Dossier.Items.Count + 1, -1 To 34)
For Each Fichier In Dossier.Items
  i& = i& + 1
  If i& = 1 Then
    For j& = -1 To 34
      T(i&, j&) = "#" & j& & " " & Dossier.GetDetailsOf(Dossier.Items, j&)
    Next j&
  End If
  For j& = -1 To 34
    T(i& + 1, j&) = Dossier.GetDetailsOf(Fichier, j&)
  Next j&
Next Fichier
Set S = Sheets.Add
Set R = S.Range(S.Cells(1, 1), S.Cells(UBound(T, 1), UBound(T, 2) + 2))
R = T
With S.Range(S.Cells(1, 1), S.Cells(1, UBound(T, 2) + 2))
  .Font.Bold = True
  .HorizontalAlignment = xlCenter
  .Interior.ColorIndex = 34
End With
S.Columns.AutoFit
Set ShellApp = Nothing
End Sub

Les propriétés des fichiers (ou dossiers) contenus dans le dossier choisi s'affichent dans une nouvelle feuille.
Vous devriez être particulièrement intéressé par les propriétés #1 et #0 qui semblent répondre à votre attente.

Cordialement.

PMO
Patrick Morange