Identfy incoming mail by subject - vba

Question

I auto export email details from Outlook to Excel every time a new mail is received. Emails are exported correctly into Excel.
I want to refine the code such that only mails with a specific subject is exported into Excel.
Code used is as follows:
Public WithEvents objMails As Outlook.Items
Private Sub Application_Startup()
Set objMails = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub objMails_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim strExcelFile As String
Dim objExcelApp As Excel.Application
Dim objExcelWorkBook As Excel.Workbook
Dim objExcelWorkSheet As Excel.Worksheet
Dim nNextEmptyRow As Integer
Dim strColumnB As String
Dim strColumnC As String
Dim strColumnD As String
Dim strColumnE As String
Dim strColumnF As String
If Item.Class = olMail Then
Set objMail = Item
End If
'Specify the Excel file which you want to auto export the email list
'You can change it as per your case
strExcelFile = "C:\Users\pddamoda\Desktop\abc.xlsx"
'Get Access to the Excel file
On Error Resume Next
Set objExcelApp = GetObject(, "Excel.Application")
If Error <> 0 Then
Set objExcelApp = CreateObject("Excel.Application")
End If
Set objExcelWorkBook = objExcelApp.Workbooks.Open(strExcelFile)
Set objExcelWorkSheet = objExcelWorkBook.Sheets("Sheet1")
'Get the next empty row in the Excel worksheet
nNextEmptyRow = objExcelWorkSheet.Range("B" & objExcelWorkSheet.Rows.Count).End(xlUp).Row + 1
'Specify the corresponding values in the different columns
strColumnB = objMail.SenderName
strColumnC = objMail.SenderEmailAddress
strColumnD = objMail.Subject
strColumnE = objMail.ReceivedTime
strColumnF = objMail.Body
'Add the vaules into the columns
objExcelWorkSheet.Range("A" & nNextEmptyRow) = nNextEmptyRow - 1
objExcelWorkSheet.Range("B" & nNextEmptyRow) = strColumnB
objExcelWorkSheet.Range("C" & nNextEmptyRow) = strColumnC
objExcelWorkSheet.Range("D" & nNextEmptyRow) = strColumnD
objExcelWorkSheet.Range("E" & nNextEmptyRow) = strColumnE
objExcelWorkSheet.Range("F" & nNextEmptyRow) = strColumnF
'Fit the columns from A to E
objExcelWorkSheet.Columns("A:F").AutoFit
'Save the changes and close the Excel file
objExcelWorkBook.Close SaveChanges:=True
End Sub

Answer 1

Below is an example of using Item.Restrict, Restrict is better when you have large search range. You can read this post for more information: Find an email starting with specific subject using VBA
sub exampleFilter()
Dim myOlApp As New Outlook.Application
Dim objNamespace As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Dim filteredItems As Outlook.Items
Dim itm As Object
Dim eFilter As String
Set myOlApp = GetObject(, "Outlook.Application")
Set objNamespace = myOlApp.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Dim emailSubject As String
emailSubject = "The Subject You like to Filter"
eFilter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & _
Chr(34) & " = '" + emailSubject + "'"
Set filteredItems = objFolder.Items.Restrict(eFilter)
If filteredItems.Count = 0 Then
debug.print "No Email with that subject found"
Else
For Each itm In filteredItems
Debug.Print itm.Subject
Next
End If
If filteredItems.Count <> 0 Then
Debug.Print "Found " & filteredItems.Count & " items."
End If
End Sub