vba, compression fichier avec utilitaire XP

Bonjour "-=lolol=-",


J'ai passé du temps pour rechercher ce qui me semblait l'évidence. Pour
augmenter mes chances, j'élargis mes recherches au vb... et je suis outré par
ce que j'ai trouvé :
http://faq.vb.free.fr/index.php?question3

Si c'est vrai, c'est fou : on est chez Ms et ca ne marche pas !

Par contre, j'ai trouvé pas de choses pour contourner sur vbfrance.com : il
existe des utilitaires gratuits qui permettent cela (des librairies non
winzip)

Bon courage et merci de mettre un mot dans le forum si tu trouves.

Bon courage.

Philippe

Bonjour à tous,

Je reviens de chez notre ami google sans avoir trouvé la solution ... peut
être n'ai je pas assez bien cherché ...

Je souhaiterais pouvoir utiliser en vba l'utilitaire fourni par windows xp
pour créer des archives zip (envoyer vers / dossier compressé). J'ai trouvé
de nombreuses solutions avec winzip, pkzip et autres utilitaires mais je
souhaite utiliser l'utilitaire fourni avec xp.

Savez vous comment faire ?

Par avance merci pour votre aide
@+lolo

Bonjour FILK,

J'ai passé du temps pour rechercher ce qui me semblait l'évidence.
Pour augmenter mes chances, j'élargis mes recherches au vb... et je
suis outré par ce que j'ai trouvé :
http://faq.vb.free.fr/index.php?question3

Si c'est vrai, c'est fou : on est chez Ms et ca ne marche pas !

c'est un scandale !!!

je ne sais même pas si je vais te remercier pour ta réponse ... mais siiiii,
gros merci :-)

@+lolo (dégouté quand même)

"-=lolol=-" <polytek@SANSPUBfree.fr> a écrit dans le message de news:
uAYCM3vMGHA.3496@TK2MSFTNGP14.phx.gbl...

Bonjour FILK,

J'ai passé du temps pour rechercher ce qui me semblait l'évidence.
Pour augmenter mes chances, j'élargis mes recherches au vb... et je
suis outré par ce que j'ai trouvé :
http://faq.vb.free.fr/index.php?question3

Si c'est vrai, c'est fou : on est chez Ms et ca ne marche pas !

c'est un scandale !!!

je ne sais même pas si je vais te remercier pour ta réponse ... mais
siiiii, gros merci :-)

@+lolo (dégouté quand même)

cependant ce lien date de 2002 , j'attends peut être l'info de JIEL sur le
forum OUTLOOK
il faudrait voir du coté de zipfldr.dll

--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
les sites références:
Excel :http://www.excelabo.net http://xcell05.free.fr/
http://dj.joss.free.fr/
http://frederic.sigonneau.free.fr/ http://www.excel-vba-francais.com/
Word : http://faqword.free.fr/
Outlook :http://faq.outlook.free.fr/
Sql :http://sqlpro.developpez.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Et on pourrait ajouter cette piste (venant d'une recherche sur zipfldr.dll)

http://cgdev.iworld.com/forum/showthread.php?t'4445

Par contre, comment declarer et utiliser tout ça, sans exemple ???
Apellez-moi Bill de suite, svp , j'ai 2 mots àadire !!! :-)

Ben c'est pas gagné l'affaire.

Philippe

"-=lolol=-" <polytek@SANSPUBfree.fr> a écrit dans le message de news:
uAYCM3vMGHA.3496@TK2MSFTNGP14.phx.gbl...

Bonjour FILK,

J'ai passé du temps pour rechercher ce qui me semblait l'évidence.
Pour augmenter mes chances, j'élargis mes recherches au vb... et je
suis outré par ce que j'ai trouvé :
http://faq.vb.free.fr/index.php?question3

Si c'est vrai, c'est fou : on est chez Ms et ca ne marche pas !

c'est un scandale !!!

je ne sais même pas si je vais te remercier pour ta réponse ... mais
siiiii, gros merci :-)

@+lolo (dégouté quand même)

cependant ce lien date de 2002 , j'attends peut être l'info de JIEL sur le
forum OUTLOOK
il faudrait voir du coté de zipfldr.dll

--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
les sites références:
Excel :http://www.excelabo.net http://xcell05.free.fr/
http://dj.joss.free.fr/
http://frederic.sigonneau.free.fr/ http://www.excel-vba-francais.com/
Word : http://faqword.free.fr/
Outlook :http://faq.outlook.free.fr/
Sql :http://sqlpro.developpez.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Bonsour® FILK avec ferveur ;o))) vous nous disiez :

Et on pourrait ajouter cette piste (venant d'une recherche sur
zipfldr.dll)
http://cgdev.iworld.com/forum/showthread.php?t'4445

et puis peut-etre celle-ci
http://www.google.com/group/microsoft.public.windowsxp.basics/browse_thread/thread/6de7e750ac048758/e702bd4e856786a0%23e702bd4e856786a0?sa=X&oi=groupsr&start=0&num=3

ou encore celle-ci :
http://msdn.microsoft.com/vbrun/vbfusion/smallandunreadable2/

--
;o)))
@+

Les news à la source !!!
news://news.microsoft.com/microsoft.public.fr.excel
et répondez OUI

n'oubliez pas les FAQ :http://www.excelabo.net
http://dj.joss.free.fr/faq.htm
http://www.faqoe.com http://faqword.free.fr

Une solution possible, que je n'ai pas testée mais qui pourrait te donner des
idées :

''''''''''''''''''
'code copié depuis cette adresse :
'http://www.rondebruin.nl/windowsxpzip.htm

'Use the Windows XP zip handling to zip a file or files
'Ron de Bruin (last update 22 Sept 2005)
'
'Many thanks to Tim Williams for pointed me to a thread in a Scripting newsgroup.
'I have used code from this thread to create this webpage.
'
'There are three macro's below :
'
'1) you can browse to the folder you want and select the file or files
'2) You can browse to a folder and zip all files in it
'3) This macro zip all files in the folder that you enter in the code

'Note: the macro 's use also the macro and maybe the functions on the bottom of
this page

'Note 2 : en fin de module une procédure pour dézipper

Sub Zip_File_Or_Files()
Dim strDate As String, DefPath As String, sFName As String
Dim oApp As Object, iCtr As Long
Dim fname, vArr, FileNameZip

DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "" Then
DefPath = DefPath & ""
End If

strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"

'Browse to the file(s), use the Ctrl key to select more files
fname = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _
MultiSelect:=True)

If IsArray(fname) = False Then
'do nothing
Else
'Create empty Zip File
NewZip (FileNameZip)

Set oApp = CreateObject("Shell.Application")

For iCtr = LBound(fname) To UBound(fname)
vArr = Split97(fname(iCtr), "")
sFName = vArr(UBound(vArr))
If bIsBookOpen(sFName) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & fname(iCtr)
Else
'Copy the file to the compressed folder
oApp.NameSpace(FileNameZip).CopyHere (fname(iCtr))

End If
Next iCtr

MsgBox "You find the zipfile here: " & FileNameZip
Set oApp = Nothing
End If
End Sub

Sub Zip_All_Files_in_Folder_Browse()
Dim FileNameZip, FolderName, oFolder
Dim strDate As String, DefPath As String
Dim oApp As Object

DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "" Then
DefPath = DefPath & ""
End If

strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"

'Create empty Zip File
NewZip (FileNameZip)

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder to Zip", 512)
If Not oFolder Is Nothing Then
FolderName = oFolder.Self.Path
If Right(FolderName, 1) <> "" Then
FolderName = FolderName & ""
End If

'Copy the files to the compressed folder
oApp.NameSpace(FileNameZip).CopyHere oApp.NameSpace(FolderName).items

MsgBox "You find the zipfile here: " & FileNameZip

Set oApp = Nothing
Set oFolder = Nothing
End If
End Sub

Sub Zip_All_Files_in_Folder()
Dim FileNameZip, FolderName
Dim strDate As String, DefPath As String
Dim oApp As Object

DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "" Then
DefPath = DefPath & ""
End If

FolderName = "C:Data" '<< Change

strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"

'Create empty Zip File
NewZip (FileNameZip)

Set oApp = CreateObject("Shell.Application")

'Copy the files to the compressed folder
oApp.NameSpace(FileNameZip).CopyHere oApp.NameSpace(FolderName).items

MsgBox "You find the zipfile here: " & FileNameZip

Set oApp = Nothing
End Sub


'Code that the macro's above use

Sub NewZip(sPath)
'Create empty Zip File
Dim oFSO, arrHex, sBin, i, Zip
Set oFSO = CreateObject("Scripting.FileSystemObject")

arrHex = 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(arrHex)
sBin = sBin & Chr(arrHex(i))
Next

With oFSO.CreateTextFile(sPath, True)
.Write sBin
.Close
End With
End Sub


Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function Split97(sStr As Variant, sdelim As String) As Variant
'Tom Ogilvy
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function



'With This example you can browse to the zip file.
'The macro will create a new folder in your DefaultFilePath and unzip the
zipfile in that folder

Sub Unzip()
Dim oApp As Object
Dim fname
Dim FileNameFolder

fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:úlse)
If fname = False Then
'do nothing
Else
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "" Then
DefPath = DefPath & ""
End If

strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate

'Create normal folder
MkDir FileNameFolder

Set oApp = CreateObject("Shell.Application")
'Copy the files in the newly created folder
oApp.NameSpace(FileNameFolder).CopyHere oApp.NameSpace(fname).items

MsgBox "You find the files here: " & FileNameFolder
Set oApp = Nothing
End If
End Sub
''''''''''''''''''

----------
Ange Ounis
----------

Bonjour à tous,

Je reviens de chez notre ami google sans avoir trouvé la solution ...
peut être n'ai je pas assez bien cherché ...

Je souhaiterais pouvoir utiliser en vba l'utilitaire fourni par windows
xp pour créer des archives zip (envoyer vers / dossier compressé). J'ai
trouvé de nombreuses solutions avec winzip, pkzip et autres utilitaires
mais je souhaite utiliser l'utilitaire fourni avec xp.

Savez vous comment faire ?

Par avance merci pour votre aide
@+lolo