Open Outlook & check for new mail where search criteria is applied to the email subject line (1 Viewer)

[Jason Lee Hayes]

Hi,

Struggling; I'm trying to open Outlook from VBA that searches all email received from all accounts in the past 2 minutes and report true IF an email subject line contains specific words.

The following code runs; no issue but fails to identify.

Any help would be appreciated.

Sub CheckForNewTicketInAllFolders()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim lastTwoMinutes As Date
    Dim mailFound As Boolean

    ' Set the Outlook application
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    ' Define the time window to check for emails (past 2 minutes)
    lastTwoMinutes = Now - TimeValue("00:02:00")
    mailFound = False

    ' Loop through all folders starting from the root
    CheckFolders olNamespace.Folders, lastTwoMinutes, mailFound

    ' Display the appropriate message
    If mailFound Then
        MsgBox "Ticket has arrived!", vbInformation
    Else
        MsgBox "No new ticket", vbExclamation
    End If

    ' Clean up
    Set olNamespace = Nothing
    Set olApp = Nothing
End Sub

Sub CheckFolders(folders As Outlook.Folders, lastTwoMinutes As Date, ByRef mailFound As Boolean)
    Dim olFolder As Outlook.Folder
    Dim olItems As Outlook.Items
    Dim olItem As Object

    For Each olFolder In folders
        ' Loop through items in the current folder
        Set olItems = olFolder.Items
        For Each olItem In olItems
            ' Check if the item is an email and matches the subject and time criteria
            If TypeOf olItem Is Outlook.MailItem Then
                If InStr(1, olItem.Subject, "Ticket received", vbTextCompare) > 0 And olItem.ReceivedTime >= lastTwoMinutes Then
                    mailFound = True
                    Exit Sub
                End If
            End If
        Next olItem
        ' Recursively check subfolders
        If olFolder.Folders.Count > 0 Then
            CheckFolders olFolder.Folders, lastTwoMinutes, mailFound
        End If
    Next olFolder
End Sub

 

[Gasman]

Not walked your code and inspected the variables I assume?

 

[GPGeorge]

Hi,

Struggling; I'm trying to open Outlook from VBA that searches all email received from all accounts in the past 2 minutes and report true IF an email subject line contains specific words.

The following code runs; no issue but fails to identify.

Any help would be appreciated.

Sub CheckForNewTicketInAllFolders()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim lastTwoMinutes As Date
    Dim mailFound As Boolean

    ' Set the Outlook application
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
  
    ' Define the time window to check for emails (past 2 minutes)
    lastTwoMinutes = Now - TimeValue("00:02:00")
    mailFound = False

    ' Loop through all folders starting from the root
    CheckFolders olNamespace.Folders, lastTwoMinutes, mailFound

    ' Display the appropriate message
    If mailFound Then
        MsgBox "Ticket has arrived!", vbInformation
    Else
        MsgBox "No new ticket", vbExclamation
    End If

    ' Clean up
    Set olNamespace = Nothing
    Set olApp = Nothing
End Sub

Sub CheckFolders(folders As Outlook.Folders, lastTwoMinutes As Date, ByRef mailFound As Boolean)
    Dim olFolder As Outlook.Folder
    Dim olItems As Outlook.Items
    Dim olItem As Object

    For Each olFolder In folders
        ' Loop through items in the current folder
        Set olItems = olFolder.Items
        For Each olItem In olItems
            ' Check if the item is an email and matches the subject and time criteria
            If TypeOf olItem Is Outlook.MailItem Then
                If InStr(1, olItem.Subject, "Ticket received", vbTextCompare) > 0 And olItem.ReceivedTime >= lastTwoMinutes Then
                    mailFound = True
                    Exit Sub
                End If
            End If
        Next olItem
        ' Recursively check subfolders
        If olFolder.Folders.Count > 0 Then
            CheckFolders olFolder.Folders, lastTwoMinutes, mailFound
        End If
    Next olFolder
End Sub

My guess is that the last folder you check will always be the one folder than controls whether you get back a true or a false, regardless of whether there is new email in any other folder.

Like the G'Man says, set a breakpoint and walk the code to see what value each variable has at each step.

 

[Gasman]

It works for me, in that it finds an email.
However I believe as you are calling it recursively, you are overwriting the mailfound = True back to False.

I say this as it went to Exit Sub, yet continued with If olFolder.Folders.Count > 0 Then

So walk your code with a breakpoint on mailFound = True

See the last lines here? https://help.campbellsci.com/crbasi...atement causes,Exit Sub statement is optional.

 

[CJ_London]

Also depends on what you want to do with the information- stop when a record is found? Return the folder where it was found? Keep looking until all folders have been searched?

 

[Gasman]

Currently it is finding a message then keeping on searching

The origianl Exit Sub was not exiting the sub, but carrying on.

This is a bodge, but does work. Yours does to, just searched needlessly after being true.

    For Each olFolder In folders
        ' Loop through items in the current folder
        Set olItems = olFolder.Items
        For Each olItem In olItems
            ' Check if the item is an email and matches the subject and time criteria
            If TypeOf olItem Is Outlook.MailItem Then
                If InStr(1, olItem.Subject, "Crossroads", vbTextCompare) > 0 And olItem.ReceivedTime >= lastTwoMinutes Then
                    mailFound = True
                    Exit For
                End If
            End If
        Next olItem
        ' Recursively check subfolders
        If olFolder.folders.Count > 0 And Not mailFound Then
            CheckFolders olFolder.folders, lastTwoMinutes, mailFound
        End If
        If mailFound Then Exit Sub
    Next olFolder

In fact you were not overwriting mailfound as that is set in the first sub, so why you cannot find a message, would infer no message exists?

 

[Mark_]

If InStr(1, olItem.Subject, "Crossroads", vbTextCompare) > 0 And olItem.ReceivedTime >= lastTwoMinutes Then
This need to be two checks.
One if is you have found the text.
Second is if you've gone past two minutes.
As is, this should be reading ALL subject lines. Not sure how well this will work if you have a massively overloaded inbox.

Logic should be "If we've found what we are looking for, return TRUE so we can exit out of everything. If it is passed two minutes, exit out so we can go to the next folder".

 

[Gasman]

Does take a while on my laptop due to my many emails, hence my bodge. However if the o/p bothers to walk his code, he will see the issue.
However his code does work IF such a subject exists.

 

[GPGeorge]

If InStr(1, olItem.Subject, "Crossroads", vbTextCompare) > 0 And olItem.ReceivedTime >= lastTwoMinutes Then
This need to be two checks.
One if is you have found the text.
Second is if you've gone past two minutes.
As is, this should be reading ALL subject lines. Not sure how well this will work if you have a massively overloaded inbox.

Logic should be "If we've found what we are looking for, return TRUE so we can exit out of everything. If it is passed two minutes, exit out so we can go to the next folder".

I didn't read the original question to be looking for the existence one specific email that matched the criteria. I.e. returning "true" if it was found.

"... all email received from all accounts in the past 2 minutes and report true IF an email subject line contains specific words."

I understood that to mean "find all emails that match the search criteria so we can do something with all of them."

Perhaps I'm wrong about that?

 

[Gasman]

My understanding was do any exist?

 

[Mark_]

@GPGeorge,
OP is looking for "Did we receive it within the last two minutes". If he had my Email, he'd be looking back to last decade with this code.

 

[GPGeorge]

@GPGeorge,
OP is looking for "Did we receive it within the last two minutes". If he had my Email, he'd be looking back to last decade with this code.

Yup, I phrased that badly.

I thought it was "All" email from "All" accounts received within the last 2 minutes. I.e. it could be more than one email in more than one subfolder. Not just one specific email in one location.

 

[Jason Lee Hayes]

Hi,

Thanks for the replies and support.

I am going to put this idea on hold now as I have exhausted the VBA. I achieved what I using email piping for now. The issue with this code is it fails to accurately identify new mail within inbox folder. To keep it simple, I forcefully used the default account, which is an outlook.com account, not an IMAP account, as thought it might be an issue with the IMAP account since they are not identified within the ListAllStores subroutine The code works and shows nothing debug, but it fails to include any emails received for that day.

Fail Result: I know there is 11 email messages in the inbox folder of which 3 are marked as unread yet the outcome after running the code only identifies 8 of which 0 are marked as Unread...

I would appreciate it if someone could test the code to see if it is accurate on your system.

Sub CountEmailsInFolder(folder As Outlook.folder, ByRef unreadCount As Long, ByRef readCount As Long, ByRef totalCount As Long)
    Dim olItems As Outlook.Items
    Dim olItem As Object
    Dim olMail As Outlook.MailItem
    Dim subFolder As Outlook.folder

    ' Loop through items in the current folder
    On Error Resume Next
    Set olItems = folder.Items
    On Error GoTo 0
    For Each olItem In olItems
        ' Check if the item is an email
        If TypeOf olItem Is Outlook.MailItem Then
            Set olMail = olItem
            totalCount = totalCount + 1
            Debug.Print "Checking Email: " & olMail.Subject & " (Unread: " & olMail.UnRead & ")"
            If olMail.UnRead Then
                unreadCount = unreadCount + 1
                Debug.Print "Unread Email: " & olMail.Subject
            Else
                readCount = readCount + 1
                Debug.Print "Read Email: " & olMail.Subject
            End If
        End If
    Next olItem

    ' Recursively check subfolders
    For Each subFolder In folder.folders
        CountEmailsInFolder subFolder, unreadCount, readCount, totalCount
    Next subFolder
End Sub

Sub ListAllStores()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olStore As Outlook.Store
   
    ' Initialize Outlook application
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
   
    ' List all stores
    For Each olStore In olNamespace.Stores
        Debug.Print "Store Display Name: " & olStore.DisplayName
    Next olStore
   
    ' Clean up
    Set olStore = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
End Sub

 

[Gasman]

I tested your first block of code and it identified a message that had the subject I was testing for?

How is meant to call that sub?