winzip - rondebruin's instructions

[Theo]

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

 

[Joel]

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

Set oApp = Nothing
End Sub

 

[Theo]

I got the message at the end, but no files to be found - I'm comparing your
code to the original to see if I can find what's wrong/missing.
T

 

[Ron de Bruin]

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

 

[Theo]

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 -

 

[Joel]

My code keeps the zip files in the same directory as the original files and
adds the date to the zip file name like Ron's code did. All you should have
to do is change FolderName to the dirrectory where the source files are
located. There should be no reason this code shouldn't work.

 

[Theo]

Hi Joel - not sure what I did before - I was getting the pop-up message, but
without the folder name in it.
So, I deleted everything, recopied your code and now it works.
So very cool!
Thanks!
T

 

[Carrie L.]

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.