Sub moveemail()
' In the Visual Basic Editor (VBE)
'  Tools menu | References...
'  Tick the entry for
'   Microsoft VBScript Regular Expressions 5.5
' &
' microsoft outlook 12.0 object libary
Dim nsNamespace As Outlook.Namespace
Dim objSourceFolder As Outlook.MAPIFolder
Dim moveToFolder As Outlook.MAPIFolder
Dim searchItems As Items
Dim msg As MailItem
Dim foundFlag As Boolean
Dim i As Long
Set NS = CreateObject("Outlook.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")
Set moveToFolder = NS.Folders("Personal Folders").Folders("Drafts").Folders("testing").Folders("test")
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)
            MsgBox (searchItems(i))
            Call whattodonow
            searchItems(i).Move moveToFolder
        End If
    End If
Next
ExitRoutine:
    Set msg = Nothing
    Set searchItems = Nothing
    Set searchFolder = Nothing
    Set NS = Nothing
MsgBox ("all mail items checked")
End Sub

Sub patternabcd123456(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
 
Sub whattodonow()
MsgBox ("checking what to do now")
End Sub