Niton,
I have copied your code into excel and with help form an Excel forum and a line or two change have your code working in excel.
Thank you very much for writing the macro for me, I really appreciate it.
Below is what I now have. It works in testing and over the next couple of days will move the code into the working environment.
Thanks again niton
smiler44
Code:
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