CODEWITHSUNDEEP
excelvbaoutlook
Cássio Zanatto
Cássio Zanatto

Reputation: 1

Download email attachments from Outlook with multiple criteria

I am trying, given inputs in Excel (Date, subject, email body, mailbox, folder navigation and export to), to download the attachments from certain emails.

The code gets the correct mailbox and folder, and downloads attachments to the folder I want.

It doesn't get the date, subject and email body.
The objective is to download attachments from emails with the date onwards, the email subject contains some words and the email body contains certain words.
I get the attachments from all emails in the mailbox.

I tried to change the & for AND but with that it doesn't even download:

Sub download_attachment()

Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Object
Dim mailitem As Outlook.mailitem
Dim olAtt As Outlook.Attachment 

Dim Folder_Navigation As String
Dim folders() As String
Dim folderIndx As Long
Dim dateFormat
dateFormat = Format(Now, "dd.mm.yyyy")

Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.folders([Sheet1].[Mailbox_Name].Text)
Folder_Navigation = [Sheet1].[Folder_Navigation].Value
folders = Split(Folder_Navigation, ";")

For folderIndx = LBound(folders) To UBound(folders)
    Debug.Print folders(folderIndx)
    Set olFolder = olFolder.folders(folders(folderIndx))
Next folderIndx

For Each olItem In olFolder.Items
    If olItem.Class = olMail Then
        Set mailitem = olItem   

        Debug.Print mailitem.Subject
        Debug.Print mailitem.ReceivedTime

        If mailitem.ReceivedTime > [Sheet1].[Date].Value & _
          InStr(mailitem.Subject, [Sheet1].[Subject].Value) <> 0 & _
          InStr(mailitem.Body, [Sheet1].[Email_Body].Value) <> 0 Then
            For Each olAtt In mailitem.Attachments
                olAtt.SaveAsFile [Sheet1].[Export_To].Text & "\" & olAtt.Filename
            Next olAtt
        End If
    End If
Next olItem

Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing

End Sub

Upvotes: 0

Views: 1787

Answers (2)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66341

Firstly, as Eugene noted, do not loop through all items in a loop - let the store provider do the work: use Restrict or Find/FindNext.

Secondly, & is not an AND boolean operator in VB, it is a string concatenation operator. You need to use AND:

    If (mailitem.ReceivedTime > [Sheet1].[Date].Value) AND  _
      (InStr(mailitem.Subject, [Sheet1].[Subject].Value) <> 0) AND  _
      (InStr(mailitem.Body, [Sheet1].[Email_Body].Value) <> 0) Then
        For Each olAtt In mailitem.Attachments
            olAtt.SaveAsFile [Sheet1].[Export_To].Text & "\" & olAtt.Filename
        Next
    End If

Upvotes: 0

Eugene Astafiev
Eugene Astafiev

Reputation: 49453

First of all, there is no need to iterate over all items in the folder as shown in your code:

For Each olItem In olFolder.Items
    If olItem.Class = olMail Then

Instead, the Outlook object model provides the Find/FindNext or Restrict methods of the Items class. So, you will be able to iterate over items that correspond to your search criteria only. Read More about these methods in the following articles:

For example, the following search criteria can be used for getting items with attachments and subject containing a keyword(s):

Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & _
                   Chr(34) & " Like '%keyword%' AND " & _
                   Chr(34) & "urn:schemas:httpmail:hasattachment" & _
                   Chr(34) & "=1"

For more samples take a look at the VBA Outlook: Find specific attachment and save under different name and Check for the senderEmailAddress.

Also you may find the AdvancedSearch method of the Application class helpful. See Advanced search in Outlook programmatically: C#, VB.NET for more information.

Upvotes: 1

Related Questions