vba zip

Michd

08/12/2018 à 14:16

Bonjour,
Dézipper - traitement à effectuer - zipper le fichier.
Un fichier exemple : comment zipper plusieurs fichiers et envoyés
par Email.
Ce qui suit n'a pas été testé avec les nouvelles versions des logiciels.
Comme tu dis, ce n'est que des suggestions, l'assemblage te revient.
Cette procédure fut proposée par Frédéric Sigonneau : zipper un fichier
et le rendre auto extractible...
Les chemins et fichiers de la procédure sont à adapter
Tu dois avoir le programme Winrar d'installer.
Déclaration de l'Api dans le haut d'un module standard.
'============================================== Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _
As String, ByVal lpFile As String, ByVal lpParameters _
As String, ByVal lpDirectory As String, ByVal nShowCmd _
As Long) As Long
'----------------------------------------------------
Sub testZip()
Dim Zippeur$, Archive$, Source$
Zippeur = "C:PFilesWinRARWinRAR.exe"
Archive = "D:ClasseurZippé"
Source = "D:ClasseurAZipper.xls"
'création de l'archive
ShellExecute 0, "open", Zippeur, _
"a " & Archive & " " & Source, "", vbHide
For i = 1 To 10: DoEvents: Next
'création de l'autoextractible
ShellExecute 0, "open", Zippeur, _
"s " & Archive & ".rar " & Source, "", vbHide
For i = 1 To 10: DoEvents: Next
'suppression de l'archive
Kill Archive & ".rar"
End Sub
'----------------------------------------------------
Si tu préfères avec Winzip :
======================================== Sub Compresser()
'Cette procédure va compresser les fichiers inclus dans le répertoire
"D:temp200112010021" et les placer dans l'archive
'"C:tmpzaza.zip"
Const CheminWinZip = "C:Program FilesWinZip" 'Répertoire ou est installé
WinZip
Const NomArchive = "C:tmpzaza.zip" 'Nom du fichier Zip à créer
Const QuelFichier = "D:temp200112010021" 'Nom du dossier à compresser
'Const QuelFichier = "C:tmpzaza.txt" 'Nom du fichier à compresser
Shell (CheminWinZip & "winzip32.exe -a " & NomArchive & " " & QuelFichier)
'execution
End Sub
========================================
Sub Compresser_Plusieurs_fichiers()
'Cette procédure va "lire" le fichier "C:tmpzaza.txt" et compresser les
fichiers lus dans l'archive "C:tmpzaza.zip"
'Ici le fichier zaza.txt contient
'C:tmptest.doc
'C:tmptest.zip
'C:tmptest.xls
'Attention, une ligne par fichier
Const CheminWinZip = "C:Program FilesWinZip" 'Répertoire ou est installé
WinZip
Const NomArchive = "C:tmpzaza.zip" 'Nom du fichier Zip a créer
Const QuelFichier = "C:tmpzaza.txt" 'Nom du fichier comprenant les
fichiers à inclure
Shell (CheminWinZip & "winzip32.exe -a " & NomArchive & " @" & QuelFichier)
'execution
End Sub
================================================
Tu dois avoir Winzip
Pour dézipper un fichier, écris cette ligne de Sébastien KRECKE
Shell ("C:Program FilesWinZipwinzip32.exe -e D:_Poubelletest.zip
D:_Poubelle")
avec :
D:_Poubelletest.zip qui correspond au fichier à dézipper et D:_Poubelle
en dernier paramètre, le dossier où sera effectuée la décompression
=============================================
Dézipper un fichier avec Winzip et MOT DE PASSE
Je peux te proposer une "bidouille de qualité" qui doit être exécutée à
partir de l'interface de la feuille de calcul.
Si les fichiers sont déjà dézippés dans le répertoire, la procédure va s'exécuter
en écrasant ceux déjà présents sans rien demander !
Ce qui complique un peu la tâche, c'est d'arriver à lui faire dézipper les fichiers
pour la première fois ou les écraser dans message à l'usager dans la même
procédure...Il y a des limites à ce que l'on peut demander à Sendkeys !!!
Malgré la longueur du code, c'est très rapide et tu dois te soucier seulement
de la procédure Test(), celle qui faut lancer !
;-))
Amuse-toi bien !
Dans le haut d'un module standard, déclaration des API
'-------------------------------
'Declare Type for API call:
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
' API declarations:
Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
' Constant declarations:
Const VK_NUMLOCK = &H90
Const KEYEVENTF_EXTENDEDKEY = &H1
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1
'--------------------------------------------
Private Sub NumLock()
Dim o As OSVERSIONINFO
Dim NumLockState As Boolean
Dim keys(0 To 255) As Byte
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
GetKeyboardState keys(0)
NumLockState = keys(VK_NUMLOCK)
If NumLockState <> True Then 'Turn capslock on
If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
keys(VK_NUMLOCK) = 1
SetKeyboardState keys(0)
ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
End If
Else
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
End If
End Sub
'--------------------------------------------
Sub Dézipper(ByVal NomArchive As String, _
ByVal DossDest As String, ByVal MotDePasse As String)
Shell ("C:Program FilesWinZipwinzip32.exe -e " & NomArchive & " " & DossDest)
DoEvents
SendKeys "~" & MotDePasse
DoEvents
SendKeys "~"
DoEvents
SendKeys "%T%C"
DoEvents
SendKeys "%T"
SendKeys "%"
NumLock
End Sub
'--------------------------------------------
Sub test()
Dim Archive As String
Dim Dest As String
Dim MotPasse As String
Archive = "c:denis.zip"
Dest = "c:TTT"
MotPasse = "denis"
Dézipper Archive, Dest, MotPasse
End Sub
'--------------------------------------------
MichD

Bonjour,

Dézipper - traitement à effectuer - zipper le fichier.

Un fichier exemple : comment zipper plusieurs fichiers et envoyés
par Email.

Ce qui suit n'a pas été testé avec les nouvelles versions des logiciels.
Comme tu dis, ce n'est que des suggestions, l'assemblage te revient.

Cette procédure fut proposée par Frédéric Sigonneau : zipper un fichier
et le rendre auto extractible...
Les chemins et fichiers de la procédure sont à adapter
Tu dois avoir le programme Winrar d'installer.

Déclaration de l'Api dans le haut d'un module standard.
'============================================== Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _
As String, ByVal lpFile As String, ByVal lpParameters _
As String, ByVal lpDirectory As String, ByVal nShowCmd _
As Long) As Long

'----------------------------------------------------
Sub testZip()
Dim Zippeur$, Archive$, Source$

Zippeur = "C:PFilesWinRARWinRAR.exe"
Archive = "D:ClasseurZippé"
Source = "D:ClasseurAZipper.xls"

'création de l'archive
ShellExecute 0, "open", Zippeur, _
"a " & Archive & " " & Source, "", vbHide
For i = 1 To 10: DoEvents: Next
'création de l'autoextractible
ShellExecute 0, "open", Zippeur, _
"s " & Archive & ".rar " & Source, "", vbHide
For i = 1 To 10: DoEvents: Next
'suppression de l'archive
Kill Archive & ".rar"

End Sub
'----------------------------------------------------

Si tu préfères avec Winzip :
======================================== Sub Compresser()
'Cette procédure va compresser les fichiers inclus dans le répertoire
"D:temp200112010021" et les placer dans l'archive
'"C:tmpzaza.zip"
Const CheminWinZip = "C:Program FilesWinZip" 'Répertoire ou est installé
WinZip
Const NomArchive = "C:tmpzaza.zip" 'Nom du fichier Zip à créer
Const QuelFichier = "D:temp200112010021" 'Nom du dossier à compresser
'Const QuelFichier = "C:tmpzaza.txt" 'Nom du fichier à compresser
Shell (CheminWinZip & "winzip32.exe -a " & NomArchive & " " & QuelFichier)
'execution
End Sub
========================================
Sub Compresser_Plusieurs_fichiers()
'Cette procédure va "lire" le fichier "C:tmpzaza.txt" et compresser les
fichiers lus dans l'archive "C:tmpzaza.zip"
'Ici le fichier zaza.txt contient
'C:tmptest.doc
'C:tmptest.zip
'C:tmptest.xls
'Attention, une ligne par fichier
Const CheminWinZip = "C:Program FilesWinZip" 'Répertoire ou est installé
WinZip
Const NomArchive = "C:tmpzaza.zip" 'Nom du fichier Zip a créer
Const QuelFichier = "C:tmpzaza.txt" 'Nom du fichier comprenant les
fichiers à inclure
Shell (CheminWinZip & "winzip32.exe -a " & NomArchive & " @" & QuelFichier)
'execution
End Sub

================================================
Tu dois avoir Winzip

Pour dézipper un fichier, écris cette ligne de Sébastien KRECKE

Shell ("C:Program FilesWinZipwinzip32.exe -e D:_Poubelletest.zip
D:_Poubelle")
avec :
D:_Poubelletest.zip qui correspond au fichier à dézipper et D:_Poubelle
en dernier paramètre, le dossier où sera effectuée la décompression

=============================================

Dézipper un fichier avec Winzip et MOT DE PASSE

Je peux te proposer une "bidouille de qualité" qui doit être exécutée à
partir de l'interface de la feuille de calcul.

Si les fichiers sont déjà dézippés dans le répertoire, la procédure va s'exécuter
en écrasant ceux déjà présents sans rien demander !

Ce qui complique un peu la tâche, c'est d'arriver à lui faire dézipper les fichiers
pour la première fois ou les écraser dans message à l'usager dans la même
procédure...Il y a des limites à ce que l'on peut demander à Sendkeys !!!

Malgré la longueur du code, c'est très rapide et tu dois te soucier seulement
de la procédure Test(), celle qui faut lancer !

;-))

Amuse-toi bien !

Dans le haut d'un module standard, déclaration des API
'-------------------------------
'Declare Type for API call:
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

' API declarations:

Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Declare Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long

Private Declare Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long

' Constant declarations:
Const VK_NUMLOCK = &H90

Const KEYEVENTF_EXTENDEDKEY = &H1
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1
'--------------------------------------------
Private Sub NumLock()
Dim o As OSVERSIONINFO
Dim NumLockState As Boolean
Dim keys(0 To 255) As Byte

o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
GetKeyboardState keys(0)

NumLockState = keys(VK_NUMLOCK)
If NumLockState <> True Then 'Turn capslock on
If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
keys(VK_NUMLOCK) = 1
SetKeyboardState keys(0)
ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
End If
Else
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
End If
End Sub

'--------------------------------------------
Sub Dézipper(ByVal NomArchive As String, _
ByVal DossDest As String, ByVal MotDePasse As String)

Shell ("C:Program FilesWinZipwinzip32.exe -e " & NomArchive & " " & DossDest)
DoEvents
SendKeys "~" & MotDePasse
DoEvents
SendKeys "~"
DoEvents
SendKeys "%T%C"
DoEvents
SendKeys "%T"
SendKeys "%"
NumLock
End Sub

'--------------------------------------------
Sub test()
Dim Archive As String
Dim Dest As String
Dim MotPasse As String

Archive = "c:denis.zip"
Dest = "c:TTT"
MotPasse = "denis"

Dézipper Archive, Dest, MotPasse

End Sub
'--------------------------------------------

MichD

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour,
Dézipper - traitement à effectuer - zipper le fichier.
Un fichier exemple : comment zipper plusieurs fichiers et envoyés
par Email.
Ce qui suit n'a pas été testé avec les nouvelles versions des logiciels.
Comme tu dis, ce n'est que des suggestions, l'assemblage te revient.
Cette procédure fut proposée par Frédéric Sigonneau : zipper un fichier
et le rendre auto extractible...
Les chemins et fichiers de la procédure sont à adapter
Tu dois avoir le programme Winrar d'installer.
Déclaration de l'Api dans le haut d'un module standard.
'============================================== Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _
As String, ByVal lpFile As String, ByVal lpParameters _
As String, ByVal lpDirectory As String, ByVal nShowCmd _
As Long) As Long
'----------------------------------------------------
Sub testZip()
Dim Zippeur$, Archive$, Source$
Zippeur = "C:PFilesWinRARWinRAR.exe"
Archive = "D:ClasseurZippé"
Source = "D:ClasseurAZipper.xls"
'création de l'archive
ShellExecute 0, "open", Zippeur, _
"a " & Archive & " " & Source, "", vbHide
For i = 1 To 10: DoEvents: Next
'création de l'autoextractible
ShellExecute 0, "open", Zippeur, _
"s " & Archive & ".rar " & Source, "", vbHide
For i = 1 To 10: DoEvents: Next
'suppression de l'archive
Kill Archive & ".rar"
End Sub
'----------------------------------------------------
Si tu préfères avec Winzip :
======================================== Sub Compresser()
'Cette procédure va compresser les fichiers inclus dans le répertoire
"D:temp200112010021" et les placer dans l'archive
'"C:tmpzaza.zip"
Const CheminWinZip = "C:Program FilesWinZip" 'Répertoire ou est installé
WinZip
Const NomArchive = "C:tmpzaza.zip" 'Nom du fichier Zip à créer
Const QuelFichier = "D:temp200112010021" 'Nom du dossier à compresser
'Const QuelFichier = "C:tmpzaza.txt" 'Nom du fichier à compresser
Shell (CheminWinZip & "winzip32.exe -a " & NomArchive & " " & QuelFichier)
'execution
End Sub
========================================
Sub Compresser_Plusieurs_fichiers()
'Cette procédure va "lire" le fichier "C:tmpzaza.txt" et compresser les
fichiers lus dans l'archive "C:tmpzaza.zip"
'Ici le fichier zaza.txt contient
'C:tmptest.doc
'C:tmptest.zip
'C:tmptest.xls
'Attention, une ligne par fichier
Const CheminWinZip = "C:Program FilesWinZip" 'Répertoire ou est installé
WinZip
Const NomArchive = "C:tmpzaza.zip" 'Nom du fichier Zip a créer
Const QuelFichier = "C:tmpzaza.txt" 'Nom du fichier comprenant les
fichiers à inclure
Shell (CheminWinZip & "winzip32.exe -a " & NomArchive & " @" & QuelFichier)
'execution
End Sub
================================================
Tu dois avoir Winzip
Pour dézipper un fichier, écris cette ligne de Sébastien KRECKE
Shell ("C:Program FilesWinZipwinzip32.exe -e D:_Poubelletest.zip
D:_Poubelle")
avec :
D:_Poubelletest.zip qui correspond au fichier à dézipper et D:_Poubelle
en dernier paramètre, le dossier où sera effectuée la décompression
=============================================
Dézipper un fichier avec Winzip et MOT DE PASSE
Je peux te proposer une "bidouille de qualité" qui doit être exécutée à
partir de l'interface de la feuille de calcul.
Si les fichiers sont déjà dézippés dans le répertoire, la procédure va s'exécuter
en écrasant ceux déjà présents sans rien demander !
Ce qui complique un peu la tâche, c'est d'arriver à lui faire dézipper les fichiers
pour la première fois ou les écraser dans message à l'usager dans la même
procédure...Il y a des limites à ce que l'on peut demander à Sendkeys !!!
Malgré la longueur du code, c'est très rapide et tu dois te soucier seulement
de la procédure Test(), celle qui faut lancer !
;-))
Amuse-toi bien !
Dans le haut d'un module standard, déclaration des API
'-------------------------------
'Declare Type for API call:
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
' API declarations:
Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
' Constant declarations:
Const VK_NUMLOCK = &H90
Const KEYEVENTF_EXTENDEDKEY = &H1
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1
'--------------------------------------------
Private Sub NumLock()
Dim o As OSVERSIONINFO
Dim NumLockState As Boolean
Dim keys(0 To 255) As Byte
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
GetKeyboardState keys(0)
NumLockState = keys(VK_NUMLOCK)
If NumLockState <> True Then 'Turn capslock on
If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
keys(VK_NUMLOCK) = 1
SetKeyboardState keys(0)
ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
End If
Else
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
End If
End Sub
'--------------------------------------------
Sub Dézipper(ByVal NomArchive As String, _
ByVal DossDest As String, ByVal MotDePasse As String)
Shell ("C:Program FilesWinZipwinzip32.exe -e " & NomArchive & " " & DossDest)
DoEvents
SendKeys "~" & MotDePasse
DoEvents
SendKeys "~"
DoEvents
SendKeys "%T%C"
DoEvents
SendKeys "%T"
SendKeys "%"
NumLock
End Sub
'--------------------------------------------
Sub test()
Dim Archive As String
Dim Dest As String
Dim MotPasse As String
Archive = "c:denis.zip"
Dest = "c:TTT"
MotPasse = "denis"
Dézipper Archive, Dest, MotPasse
End Sub
'--------------------------------------------
MichD

Michd

08/12/2018 à 15:03

Bonjour,
Ce que tu cherches n'existe pas!
Une aide pour dézipper et zipper en vba des fichiers.
https://www.cjoint.com/c/HLioaxlLf70
MichD

Brat'ac

08/12/2018 à 15:43

Michd a utilisé son clavier pour écrire :

Bonjour,
Ce que tu cherches n'existe pas!

J'avais trouvé cela sur "excel-malin", qui avait l'avantage de ne pas
utiliser
Winzip ou 7zip, mais je suis toujours avec l'erreur "Une erreur s'est
produite" !!!
https://excel-malin.com/codes-sources-vba/vba-zip-compresser-et-decompresser-fichiers/
Sub DecompresserArchiveZip()
'par Excel-Malin.com ( https://excel-malin.com )
'---------------------------------------------------------
'gestion des erreurs
On Error GoTo ErreurDecompression
'définition des variables
Dim FSO As Object
Dim ApplicationArchivage As Object
Dim FichierArchive As Variant
Dim DossierDestination As String
'informations sur l'archive et le dossier pour les fichiers
décompressés
FichierArchive = "C:TestMonArchive.zip" 'l'archive à décompresser
DossierDestination = "C:TestDecompresse" 'le dossier dans lequel
les fichiers seront décompressés
'vérification du format du chemin du dossier de destination
If Right(DossierDestination, 1) <> "" Then DossierDestination =
DossierDestination & ""
'Décompression
Set ApplicationArchivage = CreateObject("Shell.Application")
ApplicationArchivage.Namespace(DossierDestination).CopyHere
ApplicationArchivage.Namespace(FichierArchive).items
Set ApplicationArchivage = Nothing
'Message final
MsgBox "L'archive a été décompressé..."
Exit Sub
ErreurDecompression:
MsgBox "Une erreur s'est produite..."
End Sub

Michel__D

08/12/2018 à 18:18

Bonjour,
Le 08/12/2018 à 15:43, Brat'ac a écrit :

Michd a utilisé son clavier pour écrire :
Bonjour,
Ce que tu cherches n'existe pas!

J'avais trouvé cela sur "excel-malin", qui avait l'avantage de ne pas utiliser
Winzip ou 7zip, mais je suis toujours avec l'erreur "Une erreur s'est produite" !!!
https://excel-malin.com/codes-sources-vba/vba-zip-compresser-et-decompresser-fichiers/
Sub DecompresserArchiveZip()
'par Excel-Malin.com ( https://excel-malin.com )
'---------------------------------------------------------
'gestion des erreurs
   On Error GoTo ErreurDecompression
'définition des variables
   Dim FSO As Object
   Dim ApplicationArchivage As Object
   Dim FichierArchive As Variant
   Dim DossierDestination As String
'informations sur l'archive et le dossier pour les fichiers décompressés
   FichierArchive = "C:TestMonArchive.zip" 'l'archive à décompresser
   DossierDestination = "C:TestDecompresse" 'le dossier dans lequel les fichiers seront
décompressés
'vérification du format du chemin du dossier de destination
   If Right(DossierDestination, 1) <> "" Then DossierDestination = DossierDestination & ""
'Décompression
   Set ApplicationArchivage = CreateObject("Shell.Application")
   ApplicationArchivage.Namespace(DossierDestination).CopyHere
ApplicationArchivage.Namespace(FichierArchive).items
   Set ApplicationArchivage = Nothing
'Message final
   MsgBox "L'archive a été décompressé..."
Exit Sub
ErreurDecompression:
MsgBox "Une erreur s'est produite..."
End Sub

Cela coince sur l'instruction On Error Goto ...
Essaye comme ceci :
Sub DecompresserArchiveZip()
' par Excel-Malin.com ( https://excel-malin.com )
' -----------------------------------------------
' gestion des erreurs
On Error Resume Next
' définition des variables
Dim oSHA As Object
Dim FichierZip As Variant
Dim DossierDest As String
' informations sur l'archive et le dossier pour les fichiers décompressés
FichierZip = "C:TestMonArchive.zip" 'l'archive à décompresser
DossierDest = "C:TestDecompresse" 'dossier ou les fichiers seront décompressés
' vérification du format du chemin du dossier de destination
If Right(DossierDest, 1) <> "" Then DossierDest = DossierDest & ""
' Décompression
Set oSHA = CreateObject("Shell.Application")
If Left(TypeName(oSHA), 6) = "IShell" Then
oSHA.Namespace(DossierDest).CopyHere oSHA.Namespace(FichierZip).items
End If
Set oSHA = Nothing
' Message final
If Err <> 0 Then
MsgBox "Une erreur s'est produite..."
Else
MsgBox "L'archive a été décompressé..."
End If
On Error Goto 0
End Sub

Bonjour,

Le 08/12/2018 à 15:43, Brat'ac a écrit :

Michd a utilisé son clavier pour écrire :

Bonjour,

Ce que tu cherches n'existe pas!

J'avais trouvé cela sur "excel-malin", qui avait l'avantage de ne pas utiliser
Winzip ou 7zip, mais je suis toujours avec l'erreur "Une erreur s'est produite" !!!

https://excel-malin.com/codes-sources-vba/vba-zip-compresser-et-decompresser-fichiers/

Sub DecompresserArchiveZip()
'par Excel-Malin.com ( https://excel-malin.com )
'---------------------------------------------------------
'gestion des erreurs
   On Error GoTo ErreurDecompression

'définition des variables
   Dim FSO As Object
   Dim ApplicationArchivage As Object
   Dim FichierArchive As Variant
   Dim DossierDestination As String

'informations sur l'archive et le dossier pour les fichiers décompressés
   FichierArchive = "C:TestMonArchive.zip" 'l'archive à décompresser
   DossierDestination = "C:TestDecompresse" 'le dossier dans lequel les fichiers seront
décompressés

'vérification du format du chemin du dossier de destination
   If Right(DossierDestination, 1) <> "" Then DossierDestination = DossierDestination & ""

'Décompression
   Set ApplicationArchivage = CreateObject("Shell.Application")
   ApplicationArchivage.Namespace(DossierDestination).CopyHere
ApplicationArchivage.Namespace(FichierArchive).items
   Set ApplicationArchivage = Nothing

'Message final
   MsgBox "L'archive a été décompressé..."
Exit Sub

ErreurDecompression:
MsgBox "Une erreur s'est produite..."
End Sub

Cela coince sur l'instruction On Error Goto ...

Essaye comme ceci :

Sub DecompresserArchiveZip()
' par Excel-Malin.com ( https://excel-malin.com )
' -----------------------------------------------
' gestion des erreurs
On Error Resume Next

' définition des variables
Dim oSHA As Object
Dim FichierZip As Variant
Dim DossierDest As String

' informations sur l'archive et le dossier pour les fichiers décompressés
FichierZip = "C:TestMonArchive.zip" 'l'archive à décompresser
DossierDest = "C:TestDecompresse" 'dossier ou les fichiers seront décompressés

' vérification du format du chemin du dossier de destination
If Right(DossierDest, 1) <> "" Then DossierDest = DossierDest & ""

' Décompression
Set oSHA = CreateObject("Shell.Application")
If Left(TypeName(oSHA), 6) = "IShell" Then
oSHA.Namespace(DossierDest).CopyHere oSHA.Namespace(FichierZip).items
End If
Set oSHA = Nothing

' Message final
If Err <> 0 Then
MsgBox "Une erreur s'est produite..."
Else
MsgBox "L'archive a été décompressé..."
End If
On Error Goto 0
End Sub

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour,
Le 08/12/2018 à 15:43, Brat'ac a écrit :

Michd a utilisé son clavier pour écrire :
Bonjour,
Ce que tu cherches n'existe pas!

J'avais trouvé cela sur "excel-malin", qui avait l'avantage de ne pas utiliser
Winzip ou 7zip, mais je suis toujours avec l'erreur "Une erreur s'est produite" !!!
https://excel-malin.com/codes-sources-vba/vba-zip-compresser-et-decompresser-fichiers/
Sub DecompresserArchiveZip()
'par Excel-Malin.com ( https://excel-malin.com )
'---------------------------------------------------------
'gestion des erreurs
   On Error GoTo ErreurDecompression
'définition des variables
   Dim FSO As Object
   Dim ApplicationArchivage As Object
   Dim FichierArchive As Variant
   Dim DossierDestination As String
'informations sur l'archive et le dossier pour les fichiers décompressés
   FichierArchive = "C:TestMonArchive.zip" 'l'archive à décompresser
   DossierDestination = "C:TestDecompresse" 'le dossier dans lequel les fichiers seront
décompressés
'vérification du format du chemin du dossier de destination
   If Right(DossierDestination, 1) <> "" Then DossierDestination = DossierDestination & ""
'Décompression
   Set ApplicationArchivage = CreateObject("Shell.Application")
   ApplicationArchivage.Namespace(DossierDestination).CopyHere
ApplicationArchivage.Namespace(FichierArchive).items
   Set ApplicationArchivage = Nothing
'Message final
   MsgBox "L'archive a été décompressé..."
Exit Sub
ErreurDecompression:
MsgBox "Une erreur s'est produite..."
End Sub

Cela coince sur l'instruction On Error Goto ...
Essaye comme ceci :
Sub DecompresserArchiveZip()
' par Excel-Malin.com ( https://excel-malin.com )
' -----------------------------------------------
' gestion des erreurs
On Error Resume Next
' définition des variables
Dim oSHA As Object
Dim FichierZip As Variant
Dim DossierDest As String
' informations sur l'archive et le dossier pour les fichiers décompressés
FichierZip = "C:TestMonArchive.zip" 'l'archive à décompresser
DossierDest = "C:TestDecompresse" 'dossier ou les fichiers seront décompressés
' vérification du format du chemin du dossier de destination
If Right(DossierDest, 1) <> "" Then DossierDest = DossierDest & ""
' Décompression
Set oSHA = CreateObject("Shell.Application")
If Left(TypeName(oSHA), 6) = "IShell" Then
oSHA.Namespace(DossierDest).CopyHere oSHA.Namespace(FichierZip).items
End If
Set oSHA = Nothing
' Message final
If Err <> 0 Then
MsgBox "Une erreur s'est produite..."
Else
MsgBox "L'archive a été décompressé..."
End If
On Error Goto 0
End Sub

Brat'ac

10/12/2018 à 17:46

Michel__D avait écrit le 08/12/2018 :

Bonjour,
Le 08/12/2018 à 15:43, Brat'ac a écrit :
Michd a utilisé son clavier pour écrire :
Bonjour,
Ce que tu cherches n'existe pas!

J'avais trouvé cela sur "excel-malin", qui avait l'avantage de ne pas
utiliser
Winzip ou 7zip, mais je suis toujours avec l'erreur "Une erreur s'est
produite" !!!
https://excel-malin.com/codes-sources-vba/vba-zip-compresser-et-decompresser-fichiers/
Sub DecompresserArchiveZip()
'par Excel-Malin.com ( https://excel-malin.com )
'---------------------------------------------------------
'gestion des erreurs
   On Error GoTo ErreurDecompression
'définition des variables
   Dim FSO As Object
   Dim ApplicationArchivage As Object
   Dim FichierArchive As Variant
   Dim DossierDestination As String
'informations sur l'archive et le dossier pour les fichiers décompressés
   FichierArchive = "C:TestMonArchive.zip" 'l'archive à décompresser
   DossierDestination = "C:TestDecompresse" 'le dossier dans lequel les
fichiers seront décompressés
'vérification du format du chemin du dossier de destination
   If Right(DossierDestination, 1) <> "" Then DossierDestination =
DossierDestination & ""
'Décompression
   Set ApplicationArchivage = CreateObject("Shell.Application")
   ApplicationArchivage.Namespace(DossierDestination).CopyHere
ApplicationArchivage.Namespace(FichierArchive).items
   Set ApplicationArchivage = Nothing
'Message final
   MsgBox "L'archive a été décompressé..."
Exit Sub
ErreurDecompression:
MsgBox "Une erreur s'est produite..."
End Sub

Cela coince sur l'instruction On Error Goto ...
Essaye comme ceci :
Sub DecompresserArchiveZip()
' par Excel-Malin.com ( https://excel-malin.com )
' -----------------------------------------------
' gestion des erreurs
On Error Resume Next
' définition des variables
Dim oSHA As Object
Dim FichierZip As Variant
Dim DossierDest As String
' informations sur l'archive et le dossier pour les fichiers décompressés
FichierZip = "C:TestMonArchive.zip" 'l'archive à décompresser
DossierDest = "C:TestDecompresse" 'dossier ou les fichiers seront
décompressés
' vérification du format du chemin du dossier de destination
If Right(DossierDest, 1) <> "" Then DossierDest = DossierDest & ""
' Décompression
Set oSHA = CreateObject("Shell.Application")
If Left(TypeName(oSHA), 6) = "IShell" Then
oSHA.Namespace(DossierDest).CopyHere oSHA.Namespace(FichierZip).items
End If
Set oSHA = Nothing
' Message final
If Err <> 0 Then
MsgBox "Une erreur s'est produite..."
Else
MsgBox "L'archive a été décompressé..."
End If
On Error Goto 0
End Sub

C'est OK, Merci à tous

Michel__D avait écrit le 08/12/2018 :

Bonjour,

Le 08/12/2018 à 15:43, Brat'ac a écrit :

Michd a utilisé son clavier pour écrire :

Bonjour,

Ce que tu cherches n'existe pas!

J'avais trouvé cela sur "excel-malin", qui avait l'avantage de ne pas
utiliser
Winzip ou 7zip, mais je suis toujours avec l'erreur "Une erreur s'est
produite" !!!

https://excel-malin.com/codes-sources-vba/vba-zip-compresser-et-decompresser-fichiers/

Sub DecompresserArchiveZip()
'par Excel-Malin.com ( https://excel-malin.com )
'---------------------------------------------------------
'gestion des erreurs
   On Error GoTo ErreurDecompression

'définition des variables
   Dim FSO As Object
   Dim ApplicationArchivage As Object
   Dim FichierArchive As Variant
   Dim DossierDestination As String

'informations sur l'archive et le dossier pour les fichiers décompressés
   FichierArchive = "C:TestMonArchive.zip" 'l'archive à décompresser
   DossierDestination = "C:TestDecompresse" 'le dossier dans lequel les
fichiers seront décompressés

'vérification du format du chemin du dossier de destination
   If Right(DossierDestination, 1) <> "" Then DossierDestination =
DossierDestination & ""

'Décompression
   Set ApplicationArchivage = CreateObject("Shell.Application")
   ApplicationArchivage.Namespace(DossierDestination).CopyHere
ApplicationArchivage.Namespace(FichierArchive).items
   Set ApplicationArchivage = Nothing

'Message final
   MsgBox "L'archive a été décompressé..."
Exit Sub

ErreurDecompression:
MsgBox "Une erreur s'est produite..."
End Sub

Cela coince sur l'instruction On Error Goto ...

Essaye comme ceci :

Sub DecompresserArchiveZip()
' par Excel-Malin.com ( https://excel-malin.com )
' -----------------------------------------------
' gestion des erreurs
On Error Resume Next

' définition des variables
Dim oSHA As Object
Dim FichierZip As Variant
Dim DossierDest As String

' informations sur l'archive et le dossier pour les fichiers décompressés
FichierZip = "C:TestMonArchive.zip" 'l'archive à décompresser
DossierDest = "C:TestDecompresse" 'dossier ou les fichiers seront
décompressés

' vérification du format du chemin du dossier de destination
If Right(DossierDest, 1) <> "" Then DossierDest = DossierDest & ""

' Décompression
Set oSHA = CreateObject("Shell.Application")
If Left(TypeName(oSHA), 6) = "IShell" Then
oSHA.Namespace(DossierDest).CopyHere oSHA.Namespace(FichierZip).items
End If
Set oSHA = Nothing

' Message final
If Err <> 0 Then
MsgBox "Une erreur s'est produite..."
Else
MsgBox "L'archive a été décompressé..."
End If
On Error Goto 0
End Sub

C'est OK, Merci à tous

Vous avez filtré cet utilisateur ! Consultez son message

Michel__D avait écrit le 08/12/2018 :

Bonjour,
Le 08/12/2018 à 15:43, Brat'ac a écrit :
Michd a utilisé son clavier pour écrire :
Bonjour,
Ce que tu cherches n'existe pas!

J'avais trouvé cela sur "excel-malin", qui avait l'avantage de ne pas
utiliser
Winzip ou 7zip, mais je suis toujours avec l'erreur "Une erreur s'est
produite" !!!
https://excel-malin.com/codes-sources-vba/vba-zip-compresser-et-decompresser-fichiers/
Sub DecompresserArchiveZip()
'par Excel-Malin.com ( https://excel-malin.com )
'---------------------------------------------------------
'gestion des erreurs
   On Error GoTo ErreurDecompression
'définition des variables
   Dim FSO As Object
   Dim ApplicationArchivage As Object
   Dim FichierArchive As Variant
   Dim DossierDestination As String
'informations sur l'archive et le dossier pour les fichiers décompressés
   FichierArchive = "C:TestMonArchive.zip" 'l'archive à décompresser
   DossierDestination = "C:TestDecompresse" 'le dossier dans lequel les
fichiers seront décompressés
'vérification du format du chemin du dossier de destination
   If Right(DossierDestination, 1) <> "" Then DossierDestination =
DossierDestination & ""
'Décompression
   Set ApplicationArchivage = CreateObject("Shell.Application")
   ApplicationArchivage.Namespace(DossierDestination).CopyHere
ApplicationArchivage.Namespace(FichierArchive).items
   Set ApplicationArchivage = Nothing
'Message final
   MsgBox "L'archive a été décompressé..."
Exit Sub
ErreurDecompression:
MsgBox "Une erreur s'est produite..."
End Sub

Cela coince sur l'instruction On Error Goto ...
Essaye comme ceci :
Sub DecompresserArchiveZip()
' par Excel-Malin.com ( https://excel-malin.com )
' -----------------------------------------------
' gestion des erreurs
On Error Resume Next
' définition des variables
Dim oSHA As Object
Dim FichierZip As Variant
Dim DossierDest As String
' informations sur l'archive et le dossier pour les fichiers décompressés
FichierZip = "C:TestMonArchive.zip" 'l'archive à décompresser
DossierDest = "C:TestDecompresse" 'dossier ou les fichiers seront
décompressés
' vérification du format du chemin du dossier de destination
If Right(DossierDest, 1) <> "" Then DossierDest = DossierDest & ""
' Décompression
Set oSHA = CreateObject("Shell.Application")
If Left(TypeName(oSHA), 6) = "IShell" Then
oSHA.Namespace(DossierDest).CopyHere oSHA.Namespace(FichierZip).items
End If
Set oSHA = Nothing
' Message final
If Err <> 0 Then
MsgBox "Une erreur s'est produite..."
Else
MsgBox "L'archive a été décompressé..."
End If
On Error Goto 0
End Sub

C'est OK, Merci à tous

vba zip

5 réponses

Veuillez sélectionner un problème