VBA. How to get data from Outlook message by a specific subject and time to Excel file.

[PSAv]

Good evening everybody!
I receive every working day a message with the same subject "MESSAGE SUBJECT". Using the following VBA code (please see below) I want to add a condition that will allow me to get the message not only by a specific subject name (otherwise it opens me hundreds of old messages with the same subject) but also the message which is the newest (for example today's or of a previous day).
I searched the answer everywhere but haven't found anything! Please anybody help me!
PS I am new to VBA

Sub ImporTableToExcelBySubject()
Dim xItem As Object
Dim xMailItem As MailItem
Dim Table As Word. Table Dim DOC As Word.Document
Dim XExcel As Excel.Application
Dim xWb As Workbook
Dim XWS As Worksheet
Dim I As Integer
Dim XRow As Integer

On Error Resume Next

If Application ActiveExplorer.CurrentFolder.Items.Count = 0 Then Exit Sub

Set xExcel = New Excel.Application
Set XWb = Excel Workbooks.Add
xExcel.Visible = True
Set XWS = XWb.Sheets(1)
XROW = 1

For Each xItem In Application.ActiveExplorer.CurrentFolder.Items
If xItem. Class = olMail Then
Set xMailItem = xItem

If InStr (MailItem.Subject, "MESSAGE SUBJECT") > 0 Then
Set DoC = xMailItem.GetInspector.WordEditor
For I = 1 To Doc.Tables.Count
Set xTable = xDoC.Tables(I)
xTable.Range.Copy
XWs.Paste
xROW = xRow + xTable Rows.Count + 1
XWs.Range ("A" & CStr (xRow) ).Select
Next
MailItem.Display
End If
End If
Next

xWb.Save
Excel.DisplayAlerts = True
xExcel.Visible = True
End Sub

 

[John_w]

Using the following VBA code (please see below) I want to add a condition that will allow me to get the message not only by a specific subject name (otherwise it opens me hundreds of old messages with the same subject) but also the message which is the newest (for example today's or of a previous day).

Use Restrict with a filter string to find emails with a specific subject, then after Sort the first item is the most recent with that subject:

    Dim filter As String
    Dim emailItems As Outlook.Items

    filter = "@SQL=""urn:schemas:httpmail:subject"" = 'MESSAGE SUBJECT'"
    Set emailItems = Application.ActiveExplorer.CurrentFolder.Items.Restrict(filter)
    If emailItems.Count > 0 Then
        emailItems.Sort "Received", Descending:=True
        With emailItems.Item(1)
            Debug.Print .ReceivedTime, .SenderEmailAddress, .Subject
        End With
    Else
        Debug.Print "Not found"
    End If

 

[PSAv]

Thank you John for your reply!
Unfortunately is gives me an error in this part:

emailItems.Sort "Received", Descending:=True

So i’m still trying to sort it out.
I know i’m so incompetent in vba, terribly sorry guys!!

 

[John_w]

What's the error?

Try:

emailItems.Sort "ReceivedTime", Descending:=True