VBA to download email attachments from Outlook with multi Criteria

0
votes

I am trying to create a code where from a certain inputs in excel (Date, subject, email body, mailbox, folder navigation and export to) I get the attachments from those certain emails downloaded.

My problem is that even though the code gets the correct mailbox and folder, and downloads attachements to the folder I want, it doesn't get the date, subject and email body. The whole objective is to download attachments from emails with the date onwards, the email subject cointains some words and the email body contains certain words, however what I am getting is the attachments from all emails on the mailbox.

Here is my code (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
```
excelvbaemailoutlook