Zipper des fichiers
cs_NOVICE
Messages postés
5
Date d'inscription
vendredi 17 janvier 2003
Statut
Membre
Dernière intervention
22 mars 2015
-
1 nov. 2006 à 22:37
michelxld Messages postés 402 Date d'inscription vendredi 6 août 2004 Statut Membre Dernière intervention 12 octobre 2008 - 2 nov. 2006 à 06:00
michelxld Messages postés 402 Date d'inscription vendredi 6 août 2004 Statut Membre Dernière intervention 12 octobre 2008 - 2 nov. 2006 à 06:00
3 réponses
ShareVB
Messages postés
2676
Date d'inscription
vendredi 28 juin 2002
Statut
Membre
Dernière intervention
13 janvier 2016
26
1 nov. 2006 à 22:52
1 nov. 2006 à 22:52
michelxld
Messages postés
402
Date d'inscription
vendredi 6 août 2004
Statut
Membre
Dernière intervention
12 octobre 2008
32
2 nov. 2006 à 05:47
2 nov. 2006 à 05:47
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
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
michelxld
Messages postés
402
Date d'inscription
vendredi 6 août 2004
Statut
Membre
Dernière intervention
12 octobre 2008
32
2 nov. 2006 à 06:00
2 nov. 2006 à 06:00
rebonjour
OOuuppss...j'ai oublié de préciser:
les lignes commentées
'wScript.Sleep 5000
sont à utiliser pour la version VBS
michel
OOuuppss...j'ai oublié de préciser:
les lignes commentées
'wScript.Sleep 5000
sont à utiliser pour la version VBS
michel