Windows XP zip problem

[Mark Driscol]

Excel 2003, Windows XP SP2

I have copied and modified some code from Ron de Bruin's website. I
am trying to zip a file, but the last line of the code below results
in the following error: "Run-time error '91': Object variable or With
block variable not set". Can anyone see what I am doing wrong? I
have searched this newsgroup but haven't found a post that addresses
this situation. Thanks in advance.

Sub CompressFile(ByVal wkbBook1 As Workbook)

Dim strFileNameZip As String
Dim strFileNameXls As String
Dim strWBPath As String
Dim objApp As Object

strWBPath = wkbBook1.path
If Right(strWBPath, 1) <> "\" Then strWBPath = strWBPath & "\"

' Create temporary Excel and .zip file names
strFileNameXls = strWBPath & Left(wkbBook1.Name,
Len(wkbBook1.Name) - 4) _
& " (" & Format(Now, "yyyy-mm-dd, h-mm-ss ampm") & ").xls"
strFileNameZip = strWBPath & Left(wkbBook1.Name,
Len(wkbBook1.Name) - 4) & ".zip"

' Save a copy of workbook
wkbBook1.SaveCopyAs Filename:=strFileNameXls

' Kill any old copies of .zip file
If Len(Dir(strFileNameZip)) <> 0 Then Kill strFileNameZip

' Create empty .zip file
Open strFileNameZip For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1

' Copy the file into the compressed folder
Set objApp = CreateObject("Shell.Application")
objApp.Namespace(strFileNameZip).CopyHere strFileNameXls

' Rest of code continues after this point

 

[Guest]

I suspect the problem is that you have a space in the name of your file.

Try something like changing

Set objApp = CreateObject("Shell.Application")
objApp.Namespace(strFileNameZip).CopyHere strFileNameXls

to

Set objApp = CreateObject("Shell.Application")
objApp.Namespace("'" & strFileNameZip & "'").CopyHere _
"'" & strFileNameXls & "'"

 

[Mark Driscol]

I suspect the problem is that you have a space in the name of your file.

Try something like changing

Set objApp = CreateObject("Shell.Application")
objApp.Namespace(strFileNameZip).CopyHere strFileNameXls

to

Set objApp = CreateObject("Shell.Application")
objApp.Namespace("'" & strFileNameZip & "'").CopyHere _
"'" & strFileNameXls & "'"

--
Regards,
Tom Ogilvy















- Show quoted text -

Thank you, Tom. I did try that but it gives me the same error
message. I took the code directly from this website, so I'm expecting
it should work OK. I did see Ron's warning about the copy dialog and
the CopyHere method, but haven't had a dialog box show up. Any other
suggestions would be appreciated.

http://www.rondebruin.nl/windowsxpzip.htm

 

[Ron de Bruin]

Hi Mark

If you look at the code on my site you see that I not dim as string.
Must be variant

http://www.rondebruin.nl/windowsxpzip.htm

 

[Mark Driscol]

Hi Mark

If you look at the code on my site you see that I not dim as string.
Must be variant

http://www.rondebruin.nl/windowsxpzip.htm

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm







- Show quoted text -

You are correct, Ron. Thank you for taking time to look at this.

Mark

 

[Guest]

OK, it took forever to find the problem, but the problem appears to be that
you can't declare your

strFileNameXls and strFileNameZip as String (see Ron's code).

This worked for me:

Sub Test()
Dim wbkbook1 As Workbook
Set wbkbook1 = Workbooks("AA_Demo.xls")
CompressFile wbkbook1
End Sub
Sub CompressFile(ByVal wkbBook1 As Workbook)

Dim strFileNameZip
Dim strFileNameXls
Dim strWBPath As String
Dim objApp As Object

strWBPath = wkbBook1.Path
If Right(strWBPath, 1) <> "\" Then strWBPath = strWBPath & "\"

' Create temporary Excel and .zip file names
strFileNameXls = strWBPath & Left(wkbBook1.Name, Len(wkbBook1.Name) - 4) _
& " (" & Format(Now, "yyyy-mm-dd, h-mm-ss ampm") & ").xls"
strFileNameZip = strWBPath & Left(wkbBook1.Name, Len(wkbBook1.Name) - 4)
& ".zip"
Debug.Print strFileNameXls, strFileNameZip
If Dir(strFileNameXls) <> "" Then
Kill strFileNameXls
End If
' Save a copy of workbook
wkbBook1.SaveCopyAs Filename:=strFileNameXls

' Kill any old copies of .zip file
If Len(Dir(strFileNameZip)) <> 0 Then Kill strFileNameZip

' Create empty .zip file
Open strFileNameZip For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1

' Copy the file into the compressed folder
Set objApp = CreateObject("Shell.Application")
objApp.Namespace(strFileNameZip).CopyHere strFileNameXls
On Error Resume Next
Do Until objApp.Namespace(strFileNameZip).Items.Count = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
MsgBox "Your Backup is saved here: " & strFileNameZip
End Sub

 

[Ron de Bruin]

Hi Tom

I will add note about it on my site when I update the page in the new format.
Working on a few changes of the code but it is not so easy to know if the ESC key is
pressed or when you press the Cancel button in the copy dialog when shell is working.

Do you have a idea Tom

 

[Guest]

I didn't get any copy dialog and it isn't something I have worked with.

 

[Ron de Bruin]

Thanks Tom

You only see it with a large file Tom

For example zip a workbook of 20-30 MB
Or a whole folder with a lot of files in it with the example from my site.

I will test more this week