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 |
Partager