I am struggling with this code to get the list of emails from outlook with filters of subject that contains, sender name and between two dates. The code I've used is commonly used but doesn't work for me. I get the error of cannot parse condition but unable to figure out the issue. Posting this after one week of trying various methods. I have attached the SS of error message and references used.
>>> use code - tags <<<
>>> use code - tags <<<
Code:
Sub emailextract()
Dim olapp As Outlook.Application
Dim OutlookNameSpace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer
Dim DateToCheck As String
Dim searchString As String
Dim oT As Outlook.Table
Dim oFilterItems As Object
Dim oFilterItem As Object
Dim oItems As Object
Set olapp = New Outlook.Application
Set OutlookNameSpace = olapp.GetNamespace("MAPI")
Set Folder = OutlookNameSpace.GetDefaultFolder(olFolderInbox)
fdate = Format(Range("From_Date").Value, "MM/dd/yyyy h:mm:ss AM/PM")
tdate = Format(Range("To_Date").Value, "MM/dd/yyyy h:mm:ss AM/PM")
srchSender = Range("Sender").Value
srchsub = Range("Subject").Value
searchString = Range("subject").Value
Debug.Print "searchString = " & searchString
searchString = "@SQL=""urn:schemas:httpmail:subject"" LIKE '%" & srchsub & "%' "
'searchString = "[Subject]=" & Chr(34) & srchsub & Chr(34)
'searchString = "@SQL=(""urn:schemas:httpmail:subject"" like '%" & srchsub & "%')"
Debug.Print "searchString = " & searchString
searchString = searchString & " AND "
searchString = searchString & "[ReceivedTime] >= '" & Format(fdate, "ddddd h:nn AMPM") & "' AND [ReceivedTime] <= '" & Format(tdate, "ddddd h:nn AMPM") & "'"
searchString = searchString & " AND "
searchString = searchString & "[SenderName] = '" & srchSender & "'"
Debug.Print "searchString = " & searchString
Set oFilterItems = Folder.Items.Restrict(searchString) 'this is where i get the cannot parse condition error
Debug.Print oFilterItems.Count & " items found."
oFilterItems.Sort "[SentOn]", True 'Sort the results, Descending order (True)
i = 13
With Sheets("eMail Extract")
'For Each oFilterItem In oFilterItems
For Each OutlookMail In Folder.Items.Restrict(searchString)
'If oFilterItem.Class = 43 Then
.Cells(i, 1).Value = OutlookMail.ReceivedTime
.Cells(i, 2).Value = OutlookMail.SenderName
.Cells(i, 3).Value = OutlookMail.Subject
.Cells(i, 4).Value = OutlookMail.Body
If OutlookMail.Attachments.Count > 0 Then .Cells(i, 5).Value = "Yes" Else .Cells(i, 5).Value = "No"
.Cells(i, 4).WrapText = False
i = i + 1
'End If
Next OutlookMail
End With
End Sub
Attachments
Last edited by a moderator: