Code to read Outlook mail with specific subject
Hi,
I have posted this on Mr Excel too Code to read Outlook mail with specific subject | MrExcel Message Board
So, apologies for cross posting!
Admins, Please delete it, if this should not be done.
I have this working code which reads the mail and its attachment into a local folder. It is working well.
But a new requirement is to read the mails with subject containing the words, Customer ID 1000 - Smith, JOHN P, where the word Customer ID is always static but the number and name is dynamic.
I am not sure how to resolve this as my modified code does not read the mail which contains the word, Customer ID.
Code:
Private Sub cmdOutlook_Click()
Dim olApp As Object
Dim MYFOLDER As Object
Dim OlItems As Object
Dim olMail As Object
Dim x As Integer
Dim subject As String
Dim strFile As String
Dim strFolderpath As String
Dim objDestfolder As Object
Dim filterKeywords As String
Dim filter As String
Set olApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set olApp = CreateObject("Outlook.Application")
End If
strFolderpath = "C:\Users\Testing"
'On Error Resume Next
' Set the Attachment folder.
strFolderpath = strFolderpath & "\Attachments\"
Set MYFOLDER = olApp.GetNamespace("MAPI").Folders("Customer Mailbox").Folders("Inbox")
Set OlItems = MYFOLDER.Items
'Working code
'For Each OlMail In OlItems
'strFile = OlMail & ".XML"
'strFile = strFolderpath & strFile
'If OlMail.Attachments.Count > 0 Then
'For x = 1 To OlMail.Attachments.Count
'OlMail.Attachments.item(x).SaveAsFile strFile
'Next x
'End If
'Next
'Modified code
For i = OlItems.Items.Count To 1 Step -1
If TypeOf OlItems.Items(i) Is MailItem Then
Set olMail = OlItems.Items(i)
If InStr(olMail.subject, "Customer ID") > 0 Then ' how to use the Like condition here?
strFile = strFolderpath & strFile
If olMail.Attachments.Count > 0 Then
For x = 1 To olMail.Attachments.Count
olMail.Attachments.Item(x).SaveAsFile strFile
Next x
End If
End if
End if
Next
Set MYFOLDER = Nothing
Set olMail = Nothing
Set OlItems = Nothing
Set olApp = Nothing
End Sub
