Using Namespace and Objects

Can anyone please advise how I can get the line containing Namespace working in the code below? Does it need a Declaration or Reference file, whatever?

I always get r-time error 91: "Object variable not set or With block not set"

any suggestions, ideas or advice gratefully received.

Code:

---


Public Function Unzip(DefPath, Fname)
'Unzips A File
'Fname must be FULL Path\Filename.zip
'DefPath must be valid Path you want to Unzip file TO
Dim FSO As Object
Dim oApp As Object
On Error GoTo UnZip_Err:
 
Set oApp = CreateObject("Shell.Application")
 
'Copy the files in the newly created folder
oApp.Namespace(DefPath).CopyHere oApp.Namespace(Fname).items <<<<
 
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
Exit Function

---

Code:

---

'Fname must be FULL Path\Filename.zip
'DefPath must be valid Path you want to Unzip file TO

---

These MUST be correct and my experience has been the files
must be on the same directory. To unzip from one drive to another
use copyfile to move the zip file to the correct location and
then call the UNZIP routine. Application.Wait for 2-3 secs
following either the UNZIP or ZIPP routines may also be
required. HTH. Dave

Many thanks for your comments, Dave, you are on the ball.

I have found that the calling parameters need to be Variants, not string, so have added CVar to each paramater in the Call Unzip line - that works OK.

Found that I do need to wait a few seconds, otherwise the zip and iunzip processes are interfered with - how do you recommend doing this time delay in VBA code, please Dave?

It some very useful code for which I thank Mr. Breun. I spent the last few days changing my Winzip routine to utilize this code. Here's what I've arrived at. The Zipp function has to have abit more code to allow time to zip the file (I also "borrowed this from RB's site). The Unzip function is fine. To zip a file to a different drive it seems it must first be zipped on the original drive and then copied to it's final destination. HTH. Dave

Code:

---

Public Function Zipp(ZipName, FileToZip)
'Zips A File
'ZipName must be FULL Path\Filename.zip - name Zip File to Create OR ADD To
'FileToZip must be Full Path\Filename.xls  -  Name of file you want to zip
Dim FSO As Object
Dim oApp As Object
If Dir(ZipName) = "" Then
    Open ZipName For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End If
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(ZipName).CopyHere (FileToZip)
'Keep script waiting until Compressing is done
        On Error Resume Next
        Do Until oApp.Namespace(ZipName).items.Count = 1
            Application.Wait (Now + TimeValue("0:00:01"))
        Loop
        On Error GoTo 0
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
End Function
 
 
Public Function ZiptoNewDirectory(StartDrive As String, _
EndDrive As String, ZipThatFolder As String)
'zip folder/file to a new directory
'ZipThatFolder is name of folder/file to be zipped
'eg. Call ZiptoNewDirectory("C", "F", "Testfolder")
'eg. Call ZiptoNewDirectory("C", "F", "Test.doc")
Dim FsoObj As Object, Temp2 As Object
Dim Drv As String, Foldername As String, EDrv As String
Drv = StartDrive & ":\" 'starting drive location
EDrv = EndDrive & ":\" 'ending drive location
Foldername = Drv & ZipThatFolder 'folder to be zipped
On Error Resume Next
'check for temp folder on same drive. Delete then create if it exists
Set FsoObj = CreateObject("Scripting.FileSystemObject")
Set Temp2 = FsoObj.getfolder(Drv & "temp")
If Temp2 <> "" Then
    FsoObj.deletefolder (Drv & "temp"), False
End If
FsoObj.createfolder (Drv & "temp")
'zip folder into temp folder (*same drive location)
Call Zipp(Drv & "temp" & "\" & ZipThatFolder & ".zip", Foldername & "\")
'copy zipped folder to new drive (source,destination,save)
FsoObj.CopyFile Drv & "temp" & "\" & ZipThatFolder & ".zip", _
EDrv & ZipThatFolder & ".zip", True
FsoObj.deletefolder (Drv & "temp") 'delete temp folder
Set Temp2 = Nothing
Set FsoObj = Nothing
End Function
 
Public Function UnZiptoNewDirectory(StartDrive As String, _
EndDrive As String, UnZipThatFolder As String)
'unzip folder/file to new directory
' UnZipThatFolder is zipped file name
'eg. Call UnZiptoNewDirectory("F", "C", "Testfolder")
'eg. Call UnZiptoNewDirectory("F", "C", "Test.doc")
Dim Ofsobj As Object, Temp2 As Object
Dim Drv As String, Foldername As String, EDrv As Variant
Drv = StartDrive & ":\" 'starting drive location
EDrv = EndDrive & ":\" 'ending drive location
Foldername = EDrv & UnZipThatFolder 'unzipped folder name
'if unzipped folder already exists then delete
On Error Resume Next
Set Ofsobj = CreateObject("Scripting.FileSystemObject")
Set Temp2 = Ofsobj.getfolder(Foldername)
If Temp2 <> "" Then
    Ofsobj.deletefolder (Foldername), False
End If
'unzip file to new directory
Call Unzip(EDrv, Drv & UnZipThatFolder & ".zip")
Set Temp2 = Nothing
Set Ofsobj = Nothing
End Function

---

Quote:

---

Originally Posted by Dave

It some very useful code for which I thank Mr. Breun.

---

His name is de Bruin.

My apologies to Mr. de Bruin. Thanks xld for the correction. Dave

I believe that I may have mistated the "everythings fine withe the Unzip routine" in my previous post. It is... but not the way you posted it. You need to end the function (not exit) and that red lettering was crazy. It seems like some useful code so I'm gonna blow off some web space and post the whole thing. Copy and paste and hopefully you will be zipping and unzipping away. Works for me. For fun create a "testfolder" folder on your "C" drive. Fill it full of all kinds of files. Use the code to Zip it to your "F" drive in this example. Delete the "testfolder" on the "C" drive. Then zip it back from the "F" drive to the "C" drive. You can actually call the zip and then the unzip in 2 lines of code. It didn't exist for a period of time on the "C" drive. Not sure if I like that? Getting rid of that creating then deleting folders would be good. It has something to do with creating an empty zip file on the new location and then passing the files to it rather being hammered headed with abit more code. Coding suggestions and comments always welcomed. Dave
ps. Thanks to Ron de Bruin for his great code.

To Zip...

Code:

---

'Testfolder (folder) must exist in "C" drive to start in this eg.
'(StartDrive As String, EndDrive As String, ZipThatFolder As String)
'to zip "Testfolder" from "C" to "F"
Call ZiptoNewDirectory("C", "F", "Testfolder")

---

To Unzip...

Code:

---

'(StartDrive As String, EndDrive As String, ZipThatFolder As String)
'To unzip "Testfolder" from "F" to "C"
Call UnZiptoNewDirectory("F", "C", "Testfolder")
End Sub

---

Code:

---

'Many thanks to Ron de Bruin for his great code
Public Function Zipp(ZipName, FileToZip)
'Zips A File
'ZipName must be FULL Path\Filename.zip - name Zip File to Create OR ADD To
'FileToZip must be Full Path\Filename.xls - Name of file you want to zip
Dim FSO As Object
Dim oApp As Object
If Dir(ZipName) = "" Then
    Open ZipName For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End If
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(ZipName).CopyHere (FileToZip)
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(ZipName).items.Count = 1
    Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
End Function
 
Public Function Unzip(DefPath, Fname)
'Unzips A File
'Fname must be FULL Path\Filename.zip
'DefPath must be valid Path you want to Unzip file TO
'You just need to pass 2 strings.
'C:\FullPath\Filename.zip - the file to UNZIP
'C:\FullPath\ - folder to unzip to
Dim FSO As Object
Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(DefPath).CopyHere oApp.Namespace(Fname).items
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
End Function

 
Public Function ZiptoNewDirectory(StartDrive As String, _
EndDrive As String, ZipThatFolder As String)
'zip folder/file to a new directory
'ZipThatFolder is name of folder/file to be zipped
'eg. Call ZiptoNewDirectory("C", "F", "Testfolder")
'eg. Call ZiptoNewDirectory("C", "F", "Test.doc")
Dim FsoObj As Object, Temp2 As Object
Dim Drv As String, Foldername As String, EDrv As String
Drv = StartDrive & ":\" 'starting drive location
EDrv = EndDrive & ":\" 'ending drive location
Foldername = Drv & ZipThatFolder 'folder to be zipped
On Error Resume Next
'check for temp folder on same drive. Delete then create if it exists
Set FsoObj = CreateObject("Scripting.FileSystemObject")
Set Temp2 = FsoObj.getfolder(Drv & "temp")
If Temp2 <> "" Then
    FsoObj.deletefolder (Drv & "temp"), False
End If
FsoObj.createfolder (Drv & "temp")
'zip folder into temp folder (*same drive location)
Call Zipp(Drv & "temp" & "\" & ZipThatFolder & ".zip", Foldername & "\")
'copy zipped folder to new drive (source,destination,save)
FsoObj.CopyFile Drv & "temp" & "\" & ZipThatFolder & ".zip", _
EDrv & ZipThatFolder & ".zip", True
FsoObj.deletefolder (Drv & "temp") 'delete temp folder
Set Temp2 = Nothing
Set FsoObj = Nothing
End Function
 
Public Function UnZiptoNewDirectory(StartDrive As String, _
EndDrive As String, UnZipThatFolder As String)
'unzip folder/file to new directory
' UnZipThatFolder is zipped file name
'eg. Call UnZiptoNewDirectory("F", "C", "Testfolder")
'eg. Call UnZiptoNewDirectory("F", "C", "Test.doc")
Dim Ofsobj As Object, Temp2 As Object
Dim Drv As String, Foldername As String, EDrv As Variant
Drv = StartDrive & ":\" 'starting drive location
EDrv = EndDrive & ":\" 'ending drive location
Foldername = EDrv & UnZipThatFolder 'unzipped folder name
'if unzipped folder already exists then delete
On Error Resume Next
Set Ofsobj = CreateObject("Scripting.FileSystemObject")
Set Temp2 = Ofsobj.getfolder(Foldername)
If Temp2 <> "" Then
    Ofsobj.deletefolder (Foldername), False
End If
'unzip file to new directory
Call Unzip(EDrv, Drv & UnZipThatFolder & ".zip")
Set Temp2 = Nothing
Set Ofsobj = Nothing
End Function

---

I have a .zip that contains many types of files. Let's say I'm only interested in one type, the *.txt files. Are there any options on

Code:

---

oApp.Namespace(DefPath).CopyHere oApp.Namespace(Fname).items

---

that would let me pick out the *.txt files only? I really don't want to wait for the whole .zip to unzip.

Thanks,
Tom D

Thank for sharing. This is amazing site.
T