View Single Post
 
Old 11-17-2014, 08:04 PM
niton niton is offline Windows 7 64bit Office 2010 64bit
Competent Performer
 
Join Date: Jul 2012
Posts: 102
niton is on a distinguished road
Default

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
Reply With Quote