Posted to microsoft.public.excel.programming
|
|
winzip - rondebruin's instructions
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
"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
|