Hi Ron - Yes, I want to zip each file in the folder - I thought I picked the
right one from your link, but it's zipping the folder ...
If possible, I'd like to keep the original names of the files in the zipped
files.

T
PS - I know you must hear this all the time, but your website and samples
are great -


"Ron de Bruin" wrote:

Hi Theo

Do you want to zip each file in the folder in a seperate zip file ?

See the Winzip pages on my site if you use winzip
You have more control then

http://www.rondebruin.nl/zip.htm


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Theo" wrote in message ...
http://www.rondebruin.nl/windowsxpzip.htm#mail
Hi all - I am looking for something to create winzip files for EACH workbook
in C:\Test\ below. (Code comes from Ron's website above)
But I am getting a winzip folder instead.
Any help on tweaking it to create individual winzip files would be great
(preferably using the same name instead of the date/time).
Thanks
T

Sub NewZip(sPath)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
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

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

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:\Test\" '<< Change

strDate = Format(Now, " dd-mmm-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

'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count =
oApp.Namespace(FolderName).items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop

MsgBox "You find the zipfile he " & FileNameZip
On Error GoTo 0

Set oApp = Nothing
End Sub