Finding specific email Subject in Outlook sub folder and download attached files from the email - vba

Question

I have managed to make macro that downloads attachments files from my Inbox sub folder in Outlook, but it seems i can't make it works for specific combination of symbols in the email subject.
I need to download only the attachments from email that contains "906" in the Subject name. Can someone makes the modification i need for this task, please? I'm stuck already in my code :
Sub SaveMail()
SaveEmailAttachmentsToFolder "Meteologica SA Power Forecast", "csv", ""
End Sub
Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox As String, _
ExtString As String, DestFolder As String)
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim item As Object
Dim Att As Attachment
Dim FileName As String
Dim MyDocPath As String
Dim I As Integer
Dim wsh As Object
Dim fs As Object
Dim strAttachmentName As String
On Error GoTo ThisMacro_err
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders(OutlookFolderInInbox)
I = 0
' Check subfolder for messages and exit of none found
If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in this folder : " & OutlookFolderInInbox, _
vbInformation, "Nothing Found"
Set SubFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing
Exit Sub
End If
For Each item In SubFolder.Items
For Each Att In item.Attachments
If LCase(Right(Att.FileName, Len(ExtString))) = LCase(ExtString) And InStr(strAttachmentName, "906") > 0 Then
DestFolder = "C:\Users\Confi-005\OneDrive - confi.com\Desktop\Schedule\Mail_Temp\Download\"
FileName = DestFolder & item.SenderName & " " & Att.FileName
Att.SaveAsFile FileName
I = I + 1
End If
Next Att
Next item
If I > 0 Then
MsgBox "You can find the files here : " _
& DestFolder, vbInformation, "Finished!"
Else
MsgBox "No attached files in your mail.", vbInformation, "Finished!"
End If
ThisMacro_exit:
Set SubFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing
Set fs = Nothing
Set wsh = Nothing
Exit Sub
ThisMacro_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: SaveEmailAttachmentsToFolder" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume ThisMacro_exit
End Sub

Answer 1

Iterating over all items in the folder is not really a good idea:
For Each item In SubFolder.Items
For Each Att In item.Attachments
Instead, you need to use the Find/FindNext or Restrict methods of the Items class where you can deal only with items that correspond to the specified search criteria. You may find these methods described in depth in the articles that I wrote for the technical blog:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
For example, you may use the following search criteria to find items with a specific phrase in the Subject line:
criteria = "#SQL=" & Chr(34) _
& "urn:schemas:httpmail:subject" & Chr(34) _
& " ci_phrasematch 'question'"
Read more about that in the Filtering Items Using a String Comparison article.