Download Outlook Attachments from MS Access

shieldsco
shieldsco used Ask the Experts™
on
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

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Software & Systems Engineer
Commented:
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.

Author

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
John TsioumprisSoftware & Systems Engineer

Commented:
Glad you got it working as you wanted.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial