Zipper un fichier en utilisant la fonction de compression intégrée à windows xp

Soyez le premier à donner votre avis sur cette source.

Snippet vu 18 591 fois - Téléchargée 22 fois

Contenu du snippet

Il y a quelques temps déjà, j'ai été confronté au besoin de compresser des fichiers depuis mon code VB et j'ai pû glané quelques informations sur le Net afin de pouvoir réutiliser la fonction "Send to a zipfile"; fonction intégrée dans Windows XP.

Ce code fonctionne pour VB tel quel et pour VBA et VBS avec peut-être quelques légères adaptations.

Source / Exemple :


Public Sub ZMakeZIPFile(ByVal sZIPFileName, ByVal sFileName)

Dim oShell As Object
Dim oZip As Object

   Open sZIPFileName For Output As #1

   Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)

   Close #1

   ' Copy the file in the compressed folder

   Set oShell = CreateObject("Shell.Application")
   Set oZip = oShell.Namespace(sZIPFileName)

   oZip.CopyHere sFileName

   ' Keep script waiting until Compressing is done

   Do Until oZip.Items.Count = 1
      DoEvents
   Loop

   Set oZip = Nothing
   Set oShell = Nothing

End Sub

A voir également

Ajouter un commentaire

Commentaires

Messages postés
3
Date d'inscription
mardi 2 mars 2010
Statut
Membre
Dernière intervention
2 mars 2010

C'est vrai, tres ancien mais comme j'en avais besoin et que c'etait incomplet, je me suis permis d'ajouter un commentaire qui pourait aider d'autres personnes comme moi, programmant un outil et faisant tres peu de phylosophie de programmation... ;-)))
Merci pour cette source d'aides....
Messages postés
168
Date d'inscription
vendredi 9 janvier 2004
Statut
Membre
Dernière intervention
28 juillet 2009
1
5 Janvier 2007; tout cela ne nous rajeunit pas. Vous avez été déterré une vielle source ;-)
Messages postés
33
Date d'inscription
mercredi 1 mars 2006
Statut
Membre
Dernière intervention
24 février 2008

Bonjour,

pour répondre à Patate: "Arretez avec vos appels de WSH !

Ca fait débutant, ca fait dépendre le programme de certains fichiers (sans eux le prgramme ne fonctionnera pas) et ensuite, non négligeable, pas mal de commandes WHS titillent les antivus.

A proscrire donc !"

En quoi ça fait débutant, c'est une DLL ocx (c:\Windows\System32\wshom.ocx) toujours livré dans la dernière version de windows (Win 7 pro v.5.8), les versions serveurs win2000 et suivant. Aucun déploiement d'ocx puisque de base dans l'OS, choix du langage de scripting /.vbs (vbscript), .js (javascript).

Et pour les "Pros" intégration dans MS Office via VBA, et tous langage gérant les ActiveX.
Bien sûre pour les "Pros" comme Violent_Ken vous pouvez toujours utiliser les APIS, (mais il faut évidement trouver la doc, vérifier si c'est libre de tous droits (Copyright), puis faire un programme d'install en général et là, il faut gérer les versions de DLLs (DLL HELL terme Microsoftien pour descendre une techno qu'il a lui même inventé !

Attention à l'usage dans un VBA (appel du Shell "CreateObject("Shell.Application")" dans un programme VBA, je pense qu'il y a de gros risque qu'un antivirus trouve cela suspect.

L'avis d'un non "Pro".
A+
Messages postés
3
Date d'inscription
mardi 2 mars 2010
Statut
Membre
Dernière intervention
2 mars 2010

Bonjour,

Pour VBA Excel 2007, ce code fonctionne très bien pour autant que l'on rajoute (sinon boucle à l'infini) :
- la reference "Microsoft Shell Controls and automation"
- et modifier 3 lignes :
Dim oShell As Shell 'important car Object ne fonctionne pas...
# Set oShell = CreateObject("Shell.Application")
# oShell.Namespace(sZIPFileName).copyHere sFileName
Donc plus besoin de "oZip"

Source : http://social.msdn.microsoft.com/Forums/en-US/isvvba/thread/0263175a-351d-443e-813a-3205d6a9a42d

Bon courage à tous
Messages postés
33
Date d'inscription
mercredi 1 mars 2006
Statut
Membre
Dernière intervention
24 février 2008

Salut,

moi aussi j'ai chercher à l'utiliser voici le code qui marche en VBscript / shell / wbs pour faire plaisir à PATATE ;+))
Enfin si vous voulez savoir d'ou viens cette version zip :
(Inner Media, Inc) http://www.innermedia.com/nxpr-micro.html

Code VBS : (le premier qui le transforme en VBA ou VB gagne une tringle à rideau !!!)

Const ForReading 1, ForWriting 2, ForAppending = 8
Dim Source, Destination, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys
Source = "D:\SRVDOS"
Destination = "C:\SRVDOS.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 ' pas très beau hein !
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
Afficher les 11 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.