Zipping a series of files with a macro

Gara

New Member
Joined
Jan 9, 2009
Messages
9
I'm trying to get a macro to add a file to a zip file.

I've tried the code at <TABLE style="WIDTH: 48pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=64 border=0><COLGROUP><COL style="WIDTH: 48pt" width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 48pt; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" width=64 height=17>http://www.rondebruin.nl/windowsxpzip.htm</TD></TR></TBODY></TABLE>
but I get the following error-
Run-time error '91':
Object variable or With block variable not set

The line of code reading "oApp.Namespace(FileNameZip).CopyHere FileNameXls" is highlighted when I go to debug.

I've had to modify the code to have the name for the zip file and the file to be added to the zip file come from cells in the workbook holding the macro. Any help would be much appreciated. My code is as follows:

Sub Zip_ActiveWorkbook()
Dim strDate As String
Dim DefPath As String
Dim FileNameZip, FileNameXls
Dim oApp As Object
Dim FileExtStr As String

DefPath = "C:\Documents and Settings\jmichael\Desktop\"
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If

'Create date/time string and the temporary xl* and Zip file name
If Val(Application.Version) < 12 Then
FileExtStr = ".xls"
Else
Select Case ActiveWorkbook.FileFormat
Case 51: FileExtStr = ".xlsx"
Case 52: FileExtStr = ".xlsm"
Case 56: FileExtStr = ".xls"
Case 50: FileExtStr = ".xlsb"
Case Else: FileExtStr = "notknown"
End Select

If FileExtStr = "notknown" Then
MsgBox "Sorry unknown file format"
Exit Sub
End If
End If
FileNameZip = Range("F1")

FileNameXls = Range("A3")
If Dir(FileNameZip) = "" Then
'Create empty Zip File
NewZip (FileNameZip)

'Copy the file in the compressed folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameZip).CopyHere FileNameXls

'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
MsgBox "Your Backup is saved here: " & FileNameZip
Else
MsgBox "FileNameZip or/and FileNameXls exist"
End If
End Sub
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Forum statistics

Threads
1,224,584
Messages
6,179,691
Members
452,938
Latest member
babeneker

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top