Sub TestGetFolder()
 Dim folder As Outlook.folder
 
 'Set folder = GetFolder("Personal Folders\Inbox")
 Set folder = GetFolder("Personal Folders\Drafts")
 If Not (folder Is Nothing) Then
 folder.Display
 End If
 End Sub
 

Function GetFolder(ByVal FolderPath As String) As Outlook.folder
 Dim TestFolder As Outlook.folder
 Dim FoldersArray As Variant
 Dim i As Integer
On Error GoTo GetFolder_Error
 If Left(FolderPath, 2) = "\\" Then
 FolderPath = Right(FolderPath, Len(FolderPath) - 2)
 End If
 'Convert folderpath to array
 FoldersArray = Split(FolderPath, "\")
 Set TestFolder = Application.Session.Folders.Item(FoldersArray(0))
 If Not TestFolder Is Nothing Then
 For i = 1 To UBound(FoldersArray, 1)
 Dim SubFolders As Outlook.Folders
 Set SubFolders = TestFolder.Folders
 Set TestFolder = SubFolders.Item(FoldersArray(i))
 If TestFolder Is Nothing Then
 Set GetFolder = Nothing
 End If
 Next
 End If
 'Return the TestFolder
 Set GetFolder = TestFolder
 Exit Function
GetFolder_Error:
 Set GetFolder = Nothing
 Exit Function
 End Function

'Outlook VB Macro to move selected mail item(s) to a target folder
Sub MoveToFiled()
On Error Resume Next
Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Set ns = Application.GetNamespace("MAPI")

Set moveToFolder = ns.Folders("Personal Folders\Inbox").Folders("Personal Folders\Drafts").Folders

If Application.ActiveExplorer.Selection.Count = 0 Then
   MsgBox ("No item selected")
   Exit Sub
End If
If moveToFolder Is Nothing Then
   MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
End If
For Each objItem In Application.ActiveExplorer.Selection
   If moveToFolder.DefaultItemType = olMailItem Then
      If objItem.Class = olMail Then
         objItem.Move moveToFolder
      End If
  End If
Next
Set objItem = Nothing
Set moveToFolder = Nothing
Set ns = Nothing
End Sub

 
Sub MoveToFiled()
'On Error Resume Next ' <--- Do not use this unless there is a specific purpose
                      '      Never at the start.
                      '      Not when debugging.
                      '
                      '      Turn it off as quickly as possible with
                      '      On Error GoTo 0
 
Dim ns As Outlook.Namespace
Dim moveToFolder As Outlook.MAPIFolder
 
'Dim objItem As Outlook.mailitem
Dim objItem As Object ' <--- the selected objItem may not be a mailitem
 
Set ns = Application.GetNamespace("MAPI")
 
On Error Resume Next    ' To bypass the error when the target folder is not found.
                        ' moveToFolder will be Nothing
 
' Enter the exact names of the folders
' No slashes. Walk the path one folder at a time.
Set moveToFolder = ns.folders("Personal Folders").folders("Drafts")
On Error GoTo 0         ' No need for On Error Resume Next any more
 
If moveToFolder Is Nothing Then
   MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
 
   ' There will an error moving the selected mail to a folder set to Nothing
   '  since the On Error Resume Next is off
   ' Leave now before this occurs.
   GoTo ExitRoutine
 
Else
   Debug.Print "moveToFolder: " & moveToFolder
End If
 
If Application.ActiveExplorer.Selection.count = 0 Then
   MsgBox ("No item selected")
   ' Exit Sub <--- forgot to clean up
   GoTo ExitRoutine
End If
 
For Each objItem In Application.ActiveExplorer.Selection
   If moveToFolder.DefaultItemType = olMailItem Then
      If objItem.Class = olMail Then
         objItem.Move moveToFolder
      End If
  End If
Next
 
ExitRoutine:
    Set objItem = Nothing
    Set moveToFolder = Nothing
    Set ns = Nothing
 
End Sub

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

 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