This worked for me too but I am trying to do something a little different and
need help.

I want to be able to read the zip file names and the document names from
cells in the worksheet. I am not sure how to add documents to an existing zip
instead of creating a separate zip for each document.


"Joel" wrote:


Sub NewZip(sPath)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005

Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub

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


FolderName = "C:\temp\" '<< Change
Set oApp = CreateObject("Shell.Application")
strDate = Format(Now, " dd-mmm-yy h-mm-ss")

FName = Dir(FolderName & "*.xls")

Do While FName < ""
FileNameZip = FolderName & FName & strDate & ".zip"

'Create empty Zip File
NewZip (FileNameZip)


'Copy the files to the compressed folder
oApp.Namespace(FileNameZip).CopyHere _
FolderName & FName


On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0

FName = Dir()
Loop

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

Set oApp = Nothing
End Sub

"Theo" wrote:

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