Download Outlook Attachments from MS Access

I'm using the code below to download Excel attachments from a Outlook Mailbox's Inbox  to a folder on my drive. The download works good, however I would like to download from a folder (MATS) other then the Inbox. Any thoughts?


 
  Dim ns As NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim Item As Object
    Dim Atmt As Outlook.Attachment
    Dim FileName As String
    

    
    Set ns = GetNamespace("MAPI")

    Set recip = ns.CreateRecipient("OMHA.HQ.MI.REPORTS")
   
    Set Inbox = ns.GetSharedDefaultFolder(recip, olFolderInbox)



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

    For Each Item In Inbox.Items
        For Each Atmt In Item.Attachments
            If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then
                FileName = "C:\attachments\" & Atmt.FileName
                Atmt.SaveAsFile FileName
               
            End If
        Next Atmt
    Next Item

Open in new window

shieldscoAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

John TsioumprisSoftware & Systems EngineerCommented:
Probably you have the folder MATS as a subfolder of Inbox..
So try this (just replace the code from your module)
Dim FileName As String    
    Set ns = GetNamespace("MAPI")
    Set recip = ns.CreateRecipient("OMHA.HQ.MI.REPORTS")   
    Set Inbox = ns.GetSharedDefaultFolder(recip, olFolderInbox)
     Set dirMats  = Inbox.Folders("MATS")

Open in new window

If this fails  put a watch on the Inbox variable and see how to access the folder you need.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
shieldscoAuthor Commented:
Thanks John... below is my solution

    Dim ns As NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim Item As Object
    Dim Atmt As Outlook.Attachment
    Dim FileName As String
   
    Dim SubFolder As MAPIFolder
   
   
   
   
    Set ns = GetNamespace("MAPI")

    Set recip = ns.CreateRecipient("OMHA.HQ.MI.REPORTS")
   
    Set Inbox = ns.GetSharedDefaultFolder(recip, olFolderInbox)
   
    Set SubFolder = Inbox.Folders("MATS")


    If SubFolder.Items.Count = 0 Then
   
        MsgBox "There are no messages with attachments in the MATS folder.", vbInformation, _
                "Nothing Found"
        Exit Sub
    End If

   
     For Each Item In SubFolder.Items
        For Each Atmt In Item.attachments
            If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then
                FileName = "C:\attachments\" & Atmt.FileName
                Atmt.SaveAsFile FileName
               
            End If
        Next Atmt
    Next Item
   
    ' Show summary message
    If SubFolder.Items.Count > 0 Then
        varResponse = MsgBox("Found " & i & " attached files in the MATS folder." _
        & vbCrLf & "Attachments have been saved to the C:\Attachments folder." _
        & vbCrLf & vbCrLf & "Would you like to view the files now?" _
        , vbQuestion + vbYesNo, "Finished!")
    End If
   
   
    ' Open Windows Explorer to display saved files if user chooses
        If varResponse = vbYes Then
            Shell "Explorer.exe /e,C:\Attachments", vbNormalFocus
        'End If
    Else
        MsgBox "Your response was No.", vbInformation, "Finished!"
    End If
   
    ' Clear memory
SaveAttachmentsToFolder_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
' Handle Errors
SaveAttachmentsToFolder_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 SaveAttachmentsToFolder_exit
0
John TsioumprisSoftware & Systems EngineerCommented:
Glad you got it working as you wanted.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.