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 here: " & FileNameZip
   On Error GoTo 0

   Set oApp = Nothing
End Sub