CODEWITHSUNDEEP
vbaoutlookautomation
PocketLoan
PocketLoan

Reputation: 532

Opening and saving attachments

I have some code that searches the [email protected] inbox for messages with a certain subject and then debug prints the subject to the console, I'd like to add code that saves the attachments of those emails flagged by the search. The MSDN documentation was vague on this issue.

The area I'm looking for help with is commented out with '### about 12 lines from the bottom

Sub Search_Inbox()

'This subroutine searchest the RFin Inbox for the prior month's Acting / Additional forms
'Then it saves the .xlsx attachments

Dim objNamespace As Outlook.NameSpace
Dim olShareName As Outlook.Recipient
Dim myDestFolder As Outlook.Folder
Dim objFolder As Outlook.MAPIFolder
Dim DestFolder As Outlook.MAPIFolder
Dim filteredItems As Outlook.Items
Dim itm As Object
Dim Found As Boolean
Dim strFilter As String
Dim mon As String

mon = Format(Date - 30, "mmmm")

Set objNamespace = Application.GetNamespace("MAPI")
Set olShareName = objNamespace.CreateRecipient("[email protected]")   'contains secondary address
Set objFolder = objNamespace.GetSharedDefaultFolder(olShareName, olFolderInbox)
Set DestFolder = objNamespace.GetSharedDefaultFolder(olShareName, olFolderToDo)

strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & mon & "  Acting / Additional Bonus %'"

Set filteredItems = objFolder.Items.Restrict(strFilter)

If filteredItems.Count = 0 Then
    Debug.Print "No emails found"
    Found = False
Else
    Found = True
    ' this loop displays the list of emails by subject in the debug console and saves the attachments to the specified folder
    dim z as integer
    z=0
    For Each itm In filteredItems
    z=z+1
    Debug.Print itm.Subject
    '### Insert code here to Open the attachments with .xlsx extensions, if any, in each of the emails found, save them as "[Mon] Acting / Additional Bonus (1 to n).xlsx"
    Next
End If
'If the subject isn't found:
If Not Found Then
    'NoResults.Show
Else
   Debug.Print "Found " & filteredItems.Count & " items."
End If
End Sub

Upvotes: 0

Views: 50

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66286

Try something like the following:

for each attach in itm.Attachments
  if (attach.Type = olByValue) or (attach.Type = olEmbeddeditem) Then
    attach.SaveAsFile "c:\temp\" & itm.FileName 
  End If
next

Upvotes: 2

Related Questions