Zipper des fichiers

Signaler
Messages postés
5
Date d'inscription
vendredi 17 janvier 2003
Statut
Membre
Dernière intervention
22 mars 2015
-
Messages postés
402
Date d'inscription
vendredi 6 août 2004
Statut
Membre
Dernière intervention
12 octobre 2008
-
bonjour, je recherche un code VBA pour zipper un dossier ou des fichiers
merci

3 réponses

Messages postés
402
Date d'inscription
vendredi 6 août 2004
Statut
Membre
Dernière intervention
12 octobre 2008
28
bonjour


 


Une autre possiblité pour compresser un dossier, si tu dispose de WindowsXP
La macro est adaptée d'un code VBS




testé avec Excel2002 & WinXP SP1 - SP2


 




'
'Source
'http://www.codecomments.com/archive299-2006-2-295877.html
'Const ForReading 1, ForWriting 2, ForAppending = 8


Dim Source, Destination, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys


'Spécifiez le répertoire
Source = "C:\Documents and Settings\mimi\dossier"
Destination = "C:\maSauvegarde.zip"


MyHex = _
Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)


For i = 0 To UBound(MyHex)
    MyBinary = MyBinary & Chr(MyHex(i))
Next


Set oShell = CreateObject("WScript.Shell")
Set oFileSys = CreateObject("Scripting.FileSystemObject")


'Creation de la base du fichier zip.
Set oCTF = oFileSys.CreateTextFile(Destination, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing


Set oApp = CreateObject("Shell.Application")


Set oFolder = oApp.NameSpace(Source)
If Not oFolder Is Nothing Then _
    oApp.NameSpace(Destination).CopyHere oFolder.Items


'wScript.Sleep 5000


Set oFile = Nothing
On Error Resume Next


Do While (oFile Is Nothing)
    'Attention: provoque une erreur 70 si un des fichiers à zipper
    'est toujours ouvert.
    Set oFile = oFileSys.OpenTextFile(Destination, ForAppending, False)
   
    If Err.Number <> 0 Then
        Err.Clear
        'wScript.Sleep 3000
    End If
Loop


Set oFile = Nothing
Set oFileSys = Nothing


 




michel
Messages postés
402
Date d'inscription
vendredi 6 août 2004
Statut
Membre
Dernière intervention
12 octobre 2008
28
rebonjour

OOuuppss...j'ai oublié de préciser:

les lignes commentées

'wScript.Sleep 5000

sont à utiliser pour la version VBS

michel