asked on

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

ASKER CERTIFIED SOLUTION

John Tsioumpris

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

shieldsco

ASKER

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 Tsioumpris

Glad you got it working as you wanted.