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
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