Code stopped working - "Object variable not set" Error 91

Question

This code, which extracts a zipped attachment in Outlook to a folder on the D: drive, did work for a while, but now I get a run time error 91 : "Object variable or With block variable not set"  (I don't recall having changed anything).

The line in bold below is where the problem lies.

However, if I replace the "FileNameFolder" and "Atchmt.FileName" with specific locations, like so...

oApp.NameSpace("D:\Test\").CopyHere oApp.NameSpace("D:\TestZip.zip").Items

...it works fine. What is the problem here?


Sub ExtractZip()

    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim SubFolder As MAPIFolder
    Dim Atchmt As Attachment
    Dim FileName As String
    Dim msg As Outlook.MailItem
   
    Dim oApp As Object             'variables for unzipping
    Dim FileNameFolder As Variant
    Dim fso As Object
  
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set SubFolder = Inbox.Folders("Pricelists")
   
     For Each msg In SubFolder.Items
        If msg.UnRead = True Then
            If LCase(msg.Subject) Like "*book*" Then
                For Each Atchmt In msg.Attachments
                    If Right(Atchmt.FileName, 3) = "zip" Then
                        Select Case msg.SenderEmailAddress
                       
                         Case "emailaddress"
                                FileNameFolder = "D:\Test\"
                                Set oApp = CreateObject("Shell.Application")
                                oApp.NameSpace(FileNameFolder).CopyHere oApp.NameSpace(Atchmt.FileName).Items
                               
                                On Error Resume Next
                                Set fso = CreateObject("scripting.filesystemobject")
                                fso.deletefolder Environ("Temp") & "\Temporary Directory*", True
                           
                        End Select
                    End If
                Next
            End If
        End If
     Next
   
ExtractZip_exit:
    Set msg = Nothing
    Set Atchmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Set oApp = Nothing
    Exit Sub
  
End Sub

Answer 1

I found a guy here ( http://www.codeguru.com/forum/showthread.php?t=443782 ) who had the same problem, but the solutions only work partially.

One of the solutions mentioned is to use 2 pairs of brackets around the string variable, like so:


FileNameFolder = "D:\Test\"

oApp.NameSpace((FileNameFolder)) .CopyHere oApp.NameSpace("D:\TestZip.zip").Items


This works for the first part, but if I assign the attachment name to a string variable, so that it looks like this...


Temp = Atchmt.FileName

oApp.NameSpace((FileNameFolder)) .CopyHere oApp.NameSpace((Temp)) .Items


...this does not work. Likewise the other recommended solutions, like concatenating the variable with "Error$" or simply "" do not work. It seems like it needs a specific path and filename, i.e D:\TestZip.zip

What else could be wrong? Are there any parameters I am missing, or should use?

Answer 2

Not a perfect solution, but a friend of mine came up with this work around - first save the zipped attachment to the folder, extract it, and then delete the original zip file. Here's the working code:

Sub ExtractZip()

    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim SubFolder As MAPIFolder
    Dim Atchmt As Attachment
    Dim FileName As String
    Dim msg As Outlook.MailItem
   
    Dim oApp As Object           'variables for unzipping
    Dim FileNameFolder As String
    Dim FSO As Object
  
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set SubFolder = Inbox.Folders("Books")
   
     For Each msg In SubFolder.Items
        If msg.UnRead = True Then
            If LCase(msg.Subject) Like "*book*" Then
                For Each Atchmt In msg.Attachments
                    If Right(Atchmt.FileName, 3) = "zip" Then
                        Select Case msg.SenderEmailAddress
                         Case "emailaddress"

                            FileNameFolder = "D:\Test\"
                            FileName = FileNameFolder & Atchmt.FileName
                            Atchmt.SaveAsFile FileName                                 'copy the file to the folder

                            Set oApp = CreateObject("Shell.Application")
                            oApp.NameSpace((FileNameFolder)).CopyHere oApp.NameSpace((FileName)).Items        'extract the file

                            On Error Resume Next
                            Set FSO = CreateObject("scripting.filesystemobject")
                            FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
                               
                            Kill FileName      'delete the original zip file

                        End Select
                    End If
                Next
            End If
        End If
     Next
 
End Sub