zipper un fichier excel en VBS

Question

Bonjour,

J'ai récupérer un code afin de zipper un repertoire afin de créer une archive zip. Cela fonctionne parfaitement.

Je souhaiterai modifier ce code afin de ziper un fichier excel et non plus un repertoire. Pourriez vous m'indiquer les modifications a y apporter ?

Merci d'avance pour votre coup de mains, ci dessous mon code.
@+
ydu

'*******************************************************
'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
 
Source = "C:\Documents and Settings\ydu\Bureau	est"
Destination = "C:\Documents and Settings\ydu\Bureau\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 du 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

ydu · Answer

Bonjour,

Je viens metter mon article à jour car j'ai trouver un code en VBA qui fonctionne très bien dans une macro mais je voudrai le faire en VBS quelqu'un peut il m'aider svp ?

ci dessous le code
@+

Sub ZipFichier()
    Dim oShell As Object, Fso As Object
    Dim i As Long
    Dim Fichier As String, MyBinary As String
    Dim LeZip As Variant
    Dim MyHex As Variant
    
    Fichier = "C:\le classeur.xls"
    LeZip = "C:\Ma sauvegarde.zip"
     
    Set Fso = CreateObject("Scripting.FileSystemObject")
    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
    
    With Fso.CreateTextFile(LeZip, True)
        .Write MyBinary
        .Close
    End With
    
    Set oShell = CreateObject("Shell.Application")
    oShell.NameSpace(LeZip).CopyHere (Fichier)
    
    Set oShell = Nothing
End Sub

ydu

Zipper un fichier excel en VBS

1 réponse

Votre réponse

Discussions similaires