Utilisation de 7zip en VBA pour compresser et archiver un dossier

Version imprimable

23/12/2019, 14h15
franck87

Utilisation de 7zip en VBA pour compresser et archiver un dossier

Bonjour,

Je voudrais utiliser les commandes du logiciel 7zip pour pouvoir archiver un dossier en tar puis en tar.gz sous VB Excel
Je m'explique la compression d’un répertoire en tar.gz s’effectue en 2 étapes.

Génération du fichier tar
Compression du fichier tar en tar.gz

Génération du fichier tar

Cliquer-droit sur le répertoire.
Sélectionner le menu « 7-Zip » puis « Ajouter à l’archive »
Format de l’archive : tar
Vérifier que le nom du fichier (que vous pouvez modifier) contient bien « .tar »
Cliquer sur le bouton « Ok »

Le fichier .tar est généré.

Compression du fichier tar en tar.gz

Cliquer-droit sur le fichier .tar
Sélectionner le menu « 7-Zip » puis « Ajouter à l’archive »
Format de l’archive : gzip
Niveau de compression : Ultra
Type de compression : Deflate
Taille du dictionnaire : 32KB
Taille des mots : 258
Vérifier que le nom du fichier (que vous pouvez modifier) contient bien « .tar.gz »
Cliquer sur le bouton « Ok »

Le fichier .tar.gz est généré.

pour cela j'ai besoin de connaitre les commandes faisant appel a 7zip
Si quelqu'un a déja été confronté à ce problème, son aide sera la nbienvenue.

Merci par avance
23/12/2019, 15h27
franck87

Re bonjour,

un début de code pour compresser avec 7-Zip pourrait m'aider.

Merci

pour la partie compression en .tar, voila une solution :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub TarRepertoire()
 
Dim Source
Dim Destination
Dim ObjShell
 
    Source = ThisWorkbook.Path & "\" & Enveloppe
    Destination = ThisWorkbook.Path & "\" & Enveloppe & ".tar"
 
    Set ObjShell = CreateObject("WScript.shell")
    ObjShell.Exec "C:\Program Files\7-Zip\7z.exe a -r " & Chr(34) & Destination & Chr(34) & " " & Chr(34) & Source   '*** Lance la compression avec 7-Zip
 
End Sub

Par contre de l'aide sur archivage en tar.gz serait le bienvenue.

Bonjour,

J'apporte une solution.
Merci à Jérome Baudin (https://www.jbnet.fr/systeme/windows...s-windows.html) pour son aide

Code:

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Option Private Module
'####################################################
'####################################################
#If VBA7 Then   '*** 64 Bits
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As LongPtr, lpExitCode As Long) As Long
#Else           '*** 32 Bits
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
#End If
'####################################################
'####################################################
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103
Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
 
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long
 
    If IsMissing(WindowState) Then WindowState = 1
        hProg = Shell(PathName, WindowState)
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
 
        Do
            GetExitCodeProcess hProcess, ExitCode
            DoEvents
        Loop While ExitCode = STILL_ACTIVE
 
End Sub
Sub TGZRepertoire()
 
Dim Source As Variant, SourceTar As Variant
Dim Destination As Variant, ArchiveGZ As Variant
Dim ObjShell As Object
Dim ShellStr As String
 
    Application.DisplayAlerts = False
 
    Source = ThisWorkbook.Path & "\" & Enveloppe
    Destination = ThisWorkbook.Path & "\" & Enveloppe & ".tar"
 
    Set ObjShell = CreateObject("WScript.shell")
    ObjShell.Exec "C:\Program Files\7-Zip\7z.exe a -r " & Chr(34) & Destination & Chr(34) & " " & Chr(34) & Source  '*** Lance l'archive .tar avec 7-Zip
    ShellStr = "C:\Program Files\7-Zip\7z.exe": ShellAndWait ShellStr, vbHide                                       '*** Attends que la fin du programme 7-zip
 
    SourceTar = ThisWorkbook.Path & "\" & Enveloppe & ".tar"
    ArchiveGZ = ThisWorkbook.Path & "\" & Enveloppe & ".tar.gz"
 
    ObjShell.Exec "C:\Program Files\7-Zip\7z.exe a -r " & Chr(34) & ArchiveGZ & Chr(34) & " " & Chr(34) & SourceTar '*** Lance la compression ".tar.gz" avec 7-Zip
    ShellStr = "C:\Program Files\7-Zip\7z.exe": ShellAndWait ShellStr, vbHide                                       '*** Attends que la fin du programme 7-zip
 
    Application.Wait Time + TimeSerial(0, 0, 2)                                                                     '*** Pause de 2 secondes
    Kill SourceTar
 
    Application.DisplayAlerts = True
 
End Sub