Home |
Search |
Today's Posts |
#1
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Encryption via WinZip | Excel Programming | |||
rondebruin's webpage | Excel Discussion (Misc queries) | |||
WinZip | Excel Programming | |||
winzip in macro | Excel Programming | |||
WinZip extract | Excel Programming |