Compresser un fichier avec la compression de fichier native de XP ou vista

Le
Michel Angelosanto
Bonjour,

sauriez vous comment je peux utiliser la fonction native de compression de
fichiers de Windows XP ou Vista en VBA sous Excel ?

Merci d'avance.

--
Michel Angelosanto, Bordeaux
http://angelosa.free.fr/
Questions / Réponses high-tech
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Michel Angelosanto
Le #6763221
J'ai trouvé, voici le code:
Sub Zip_ActiveWorkbook()
'compression du classeur actif
Dim strDate As String, DefPath As String
Dim FileNameZip, FileNameXls
Dim oApp As Object
DefPath = "C:temp" '<< Change
If Right(DefPath, 1) <> "" Then DefPath = DefPath & ""

'Create date/time string and the temporary xls and zip file name
strDate = Format(Now, " dd-mmm-yy h-mm-ss")
FileNameZip = DefPath & Left(ActiveWorkbook.Name,
Len(ActiveWorkbook.Name) - 4) & strDate & ".zip"
FileNameXls = DefPath & Left(ActiveWorkbook.Name,
Len(ActiveWorkbook.Name) - 4) & strDate & ".xls"
If Dir(FileNameZip) = "" And Dir(FileNameXls) = "" Then
'crée une copie du classeur actif
ActiveWorkbook.SaveCopyAs FileNameXls
'Crée un fichier zip vide
NewZip (FileNameZip)
'Copie le fichier dans le dossier compressé
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameZip).CopyHere FileNameXls
'on attend la fin de la compression
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
'on efface le fichier excel temporaire
Kill FileNameXls
MsgBox "Votre fichier est sauvé ici: " & FileNameZip
Else
MsgBox "FileNameZip ou/et FileNameXls existe déja!"
End If
End Sub
Sub NewZip(sPath)
'Crée un fichier zip vide
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub

"Michel Angelosanto" news:
Bonjour,

sauriez vous comment je peux utiliser la fonction native de compression de
fichiers de Windows XP ou Vista en VBA sous Excel ?

Merci d'avance.

--
Michel Angelosanto, Bordeaux
http://angelosa.free.fr/


--
Michel Angelosanto, Bordeaux
http://angelosa.free.fr/

Publicité
Poster une réponse
Anonyme