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

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

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" wrote:

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

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

"Joel" wrote:

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" wrote:

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