Code:
Sub searchSubject()
' In the Visual Basic Editor (VBE)
' Tools menu | References...
' Tick the entry for
' Microsoft VBScript Regular Expressions 5.5
Dim ns As Outlook.Namespace
Dim searchFolder As Folder
Dim searchItems As Items
Dim msg As mailitem
Dim foundFlag As Boolean
Dim i As Long
Set ns = Application.GetNamespace("MAPI")
On Error Resume Next ' To bypass the error when the source folder is not found.
' searchFolder will be Nothing
' Enter the exact names of the folders
' No slashes. Walk the path one folder at a time.
Set searchFolder = ns.folders("Personal Folders").folders("inbox").folders("testin").folders("testout")
On Error GoTo 0
If searchFolder Is Nothing Then
MsgBox "Source folder not found!", vbOKOnly + vbExclamation, "searchSubject error"
GoTo ExitRoutine
Else
Debug.Print vbCr & "searchFolder: " & searchFolder
End If
Set searchItems = searchFolder.Items
For i = searchItems.count To 1 Step -1
If searchItems(i).Class = olMail Then
Set msg = searchItems(i)
pattern_abcd123456 msg, foundFlag
If foundFlag = True Then
Debug.Print " Move this mail: " & searchItems(i)
End If
End If
Next
ExitRoutine:
Set msg = Nothing
Set searchItems = Nothing
Set searchFolder = Nothing
Set ns = Nothing
End Sub
Sub pattern_abcd123456(MyMail As mailitem, fndFlag)
Dim subj As String
Dim re As Object
Dim match As Variant
fndFlag = False
subj = MyMail.Subject
Set re = CreateObject("vbscript.regexp")
re.pattern = "[a-z][a-z][a-z][a-z][0-9][0-9][0-9][0-9][0-9][0-9]"
For Each match In re.Execute(subj)
fndFlag = True
Debug.Print vbCr & subj
Debug.Print " *** Pattern found: " & match
Next
End Sub