locked
Code stopped working - "Object variable not set" Error 91 RRS feed

  • 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




    Tuesday, November 3, 2009 7:52 PM

Answers

  • 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


    • Marked as answer by Tim Li Wednesday, November 11, 2009 5:43 AM
    Thursday, November 5, 2009 10:21 PM

All replies

  • 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?
    Wednesday, November 4, 2009 10:07 PM
  • 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


    • Marked as answer by Tim Li Wednesday, November 11, 2009 5:43 AM
    Thursday, November 5, 2009 10:21 PM
  • Thanks a million.  I would have probably never guessed that the double parenthesis fixed the problem.....
    Thursday, March 25, 2010 11:29 PM
  • I was having the same issue, I just ran this loop to "feed" the unzip function.  THe unzip sub was taking somewhere else off the internet, i do not recall where.

    Sub FeedUnzip()
        Dim FSO As FileSystemObject
        Dim fld As Folder
        Dim fil As File
        Dim str_DESTINATION As String
        Dim str_FILENAME As Variant
        
     
        
        Set FSO = New FileSystemObject
        Set fld = FSO.GetFolder("C:\Users\")
       
        For Each fil In fld.Files
            str_FILENAME = fil
            str_DESTINATION = "C:\Users\"
            Call UnZip(str_DESTINATION, str_FILENAME)
        Next fil

    Set FSO = Nothing

    End Sub

    Sub UnZip(strTargetPath As String, Fname As Variant)
     
        Dim oApp As Object
        Dim FileNameFolder As Variant
      

        FileNameFolder = strTargetPath
     
     
     
        Set oApp = CreateObject("Shell.Application")
     
        oApp.Namespace((FileNameFolder)).CopyHere oApp.Namespace((Fname)).Items
     
    End Sub

    Thursday, September 17, 2015 3:30 PM