How to extract text from custom flags - vba

Question

I handle a number of emails every day. I flag emails with custom text to track emails and correlate each with the other.
How do I extract emails that are flagged along with custom texts in each flagged email in a folder.
I could manage to follow VBA code available at VBA Express forum:
Sub CountItems()
Dim objMainFolder As Outlook.folder
Dim lItemsCount As Long
'Select a folder
Set objMainFolder = Outlook.Application.Session.PickFolder
If objMainFolder Is Nothing Then
MsgBox "You choose select a valid folder!", vbExclamation + vbOKOnly, "Warning for Pick Folder"
Else
'Initialize the total count
lItemsCount = 0
Call LoopFolders(objMainFolder, lItemsCount)
End If
'Display a message for the total count
MsgBox "There are " & lItemsCount & " items in the " & objMainFolder.Name & " folder Including its subfolders.", vbInformation, "Count Items"
End Sub
Sub LoopFolders(ByVal objCurrentFolder As Outlook.folder, lCurrentItemsCount As Long)
Dim objSubfolder As Outlook.folder
lCurrentItemsCount = lCurrentItemsCount + objCurrentFolder.Items.Count
'Process all folders and subfolders recursively
If objCurrentFolder.Folders.Count Then
For Each objSubfolder In objCurrentFolder.Folders
Call LoopFolders(objSubfolder, lCurrentItemsCount)
Next
End If
End Sub
It displays the count of emails in a folder and its subfolders.
I stumbled across "How do you access custom Follow-Up flag values (“Flag to…”) in Outlook 2016?" which partially solves my problem.
The solution, from what I could understand, pivots around the Search Folder in Outlook mail client and setting custom view by All Mail fields and Follow Up Flag and then setting the condition of the latter to "is not empty". Grouping by "Follow Up Flag" ascending then displays the custom flags in groups for easy reference.
However, that does not solve the problem of listing the custom flag values.

Answer 1

Iterating over all folder in Outlook and searching for specific items is not really a good idea as shown in your sample code:
'Process all folders and subfolders recursively
If objCurrentFolder.Folders.Count Then
For Each objSubfolder In objCurrentFolder.Folders
Call LoopFolders(objSubfolder, lCurrentItemsCount)
Next
End If
Instead, you may consider using the AdvancedSearch method of the Outlook Application class which performs a search based on a specified DAV Searching and Locating (DASL) search string. The AdvancedSearch method and related features in the Outlook object model do not create a Search Folder that will appear in the Outlook user interface. However, you can use the Save method of the Search object that is returned to create a Search Folder that will appear in the Search Folders list in the Outlook user interface.
The key benefits of using the AdvancedSearch method in Outlook are:
The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
Full support for DASL queries (custom properties can be used for searching too). You can read more about this in the Filtering article in MSDN. To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
Finally, you can stop the search process at any moment using the Stop method of the Search class.
Read more about that in the Advanced search in Outlook programmatically: C#, VB.NET article.
Public m_SearchComplete As Boolean
Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search)
If SearchObject.Tag = "MySearch" Then
m_SearchComplete = True
End If
End Sub
Sub TestSearchForMultipleFolders()
Dim Scope As String
Dim Filter As String
Dim MySearch As Outlook.Search
Dim MyTable As Outlook.Table
Dim nextRow As Outlook.Row
m_SearchComplete = False
'Establish scope for multiple folders
Scope = "'" & Application.Session.GetDefaultFolder(olFolderInbox).FolderPath
& "','" & Application.Session.GetDefaultFolder(olFolderSentMail).FolderPath & "'"
'Establish filter
If Application.Session.DefaultStore.IsInstantSearchEnabled Then
Filter = Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " ci_phrasematch 'Office'"
Else
Filter = Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%Office%'"
End If
Set MySearch = Application.AdvancedSearch(Scope, Filter, True, "MySearch")
While m_SearchComplete <> True
DoEvents
Wend
Set MyTable = MySearch.GetTable
Do Until MyTable.EndOfTable
Set nextRow = MyTable.GetNextRow()
Debug.Print nextRow("Subject")
Loop
End Sub
Also you may consider using the Find/FindNext or Restrict methods that allow getting items that correspond to the search filter in a specific folder (per folders). Read more about these methods in the following articles:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder

Answer 2

You can apply .Restrict on FlagRequest to count items with a custom text flag.
Option Explicit
Sub CountCustomFlagItems()
Dim objMainFolder As folder
Dim lItemsCount As Long
Dim customText As String
Dim resFilter As String
Dim uMsg As String
'Select a folder
Set objMainFolder = Session.PickFolder
If objMainFolder Is Nothing Then
' user cancelled
Exit Sub
Else
'Initialize the total count
lItemsCount = 0
customText = "Custom Text Here"
' https://learn.microsoft.com/en-us/office/vba/api/outlook.mailitem.flagrequest
resFilter = "[FlagRequest] = " & customText
Debug.Print "resFilter: " & resFilter
Call LoopFolders(objMainFolder, lItemsCount, resFilter)
End If
'Display a message for the total count
uMsg = "There are " & lItemsCount & " " & customText & " items in the " & objMainFolder.Name & _
" folder including subfolders."
Debug.Print uMsg & vbCr
'MsgBox uMsg, vbInformation, "Count Items"
End Sub
Sub LoopFolders(ByVal objCurrentFolder As folder, lCurrentItemsCount As Long, resFilter As String)
Dim objSubfolder As folder
Dim objCurrentFolderItems As Items
Dim resItms As Items
Set objCurrentFolderItems = objCurrentFolder.Items
If objCurrentFolderItems.Count Then
' https://learn.microsoft.com/en-us/office/vba/api/outlook.items.restrict
Set resItms = objCurrentFolderItems.Restrict(resFilter)
If resItms.Count Then
Debug.Print objCurrentFolder & " Items Count: " & objCurrentFolderItems.Count
Debug.Print " Filtered items in the folder " & objCurrentFolder & ": " & resItms.Count
Debug.Print
lCurrentItemsCount = lCurrentItemsCount + resItms.Count
End If
End If
'Process all folders and subfolders recursively
If objCurrentFolder.folders.Count Then
For Each objSubfolder In objCurrentFolder.folders
Call LoopFolders(objSubfolder, lCurrentItemsCount, resFilter)
Next
End If
End Sub