How do I export .zip attachments from outlook, open the .zip file to save .xlsx files

[atr4083]

I am trying to create a vba code that takes attachments in a shared folder on outlook, opens the .zip attachments, and saves the .xlsx files within the .zip attachments. I have combined two codes here and I'm getting the "Run-time Error '91'" Message. Something is wrong with the line that says oApp.NameSpace(FileNameFolder).CopyHere oApp.Namespace(Fname).items. The first code that I had simply took the zip file attachment from the email and saved the entire zip file to a specific folder in windows explorer. I am trying to combine this with another code that removes files from a zip file and saves it to another folder. Any help would be appreciated! Below is my attempt at a combined code:

Sub GetAttachments()

                Dim ns As NameSpace
                Dim Inbox As MAPIFolder
                Dim Item As Object
                Dim Atmt As Attachment
                Dim FileName As String
                Dim i As Integer
                Set ns = GetNamespace("MAPI")
                Set Inbox = ns.Folders("Mailbox - blankidy, _
                                                blank").Folders("TRA GF")
                i = 0

                If Inbox.Items.Count = 0 Then
                   MsgBox "There are no messages in the ATL ST folder.", _
                                         vbInformation, _
                   "Nothing Found"
                   Exit Sub
                End If

                For Each Item In Inbox.Items
                    For Each Atmt In Item.Attachments
                    
    Dim FSO As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim DefPath As String
    Dim strDate As String

    Fname = Atmt.FileName '(filefilter:="Zip Files (*.zip), *.zip", _
                                        'MultiSelect:=False)
    If Fname = False Then
        'Do nothing
    Else
        'Root folder for the new folder.
        'You can also use DefPath = "C:\Users\Ron\test\"
        DefPath = "server:\path\"
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If

        'Create the folder name
        strDate = Format(Now, " dd-mm-yy h-mm-ss")
        FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"

        'Make the normal folder in DefPath
        MkDir FileNameFolder

        'Extract the files into the newly created folder
        Set oApp = CreateObject("Shell.Application")

        oApp.NameSpace(FileNameFolder).CopyHere _
                               oApp.Namespace(Fname).items

        'If you want to extract only one file you can use this:
        'oApp.Namespace(FileNameFolder).CopyHere _
         'oApp.Namespace(Fname).items.Item("test.txt")

        MsgBox "You find the files here: " & FileNameFolder

        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    End If

'                       FileName = "N:\GSE\ENGINEER\ENGINEER\CO-OP\Austin Redd" & Atmt.FileName
'                       Atmt.SaveAsFile FileName
                       i = i + 1
                    Next Atmt
                Next Item

                If i > 0 Then
                    MsgBox "I found " & i & " attached files." _
                       & vbCrLf & "I have saved them into the N:\GSE\ENGINEER\ENGINEER\CO-OP\Austin Redd Attachments folder." _
                       & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
                Else
                    MsgBox "I didn't find any attached files in your mail.", vbInformation, _
                    "Finished!"
                End If

GetAttachments_exit:
                   Set Atmt = Nothing
                   Set Item = Nothing
                   Set ns = Nothing
                   Exit Sub

GetAttachments_err:
               MsgBox "An unexpected error has occurred." _
                  & vbCrLf & "Please note and report the following information." _
                  & vbCrLf & "Macro Name: GetAttachments" _
                  & vbCrLf & "Error Number: " & Err.Number _
                  & vbCrLf & "Error Description: " & Err.Description _
                  , vbCritical, "Error!"
               Resume GetAttachments_exit
    
End Sub

 

[spikepl]

You are asking for help but your presentation sux! It's like asking someone to mend your underpants or socks but forgetting to wash them first.

Clean up your code. You can use this free tool to indent it: http://www.add-ins.com/macro-produc...to-indent-vba-code/how-to-indent-vba-code.htm

I'd also recommend that you show the original code and any commnets for each of the two functions you are trying to combine.

Finally: macro in Access is a different animal from macro in Outlook. In Outlook a "macro" is VBA code, but in Access "macro" is a set of predefined things you can pick, and so far much less widely used by battle-scarred veterans. To get help for VBA post in another forum next time, eg Modules &VBA.