Outlook VBA help...

[MrTrue]

Hello Everyone,
I've been researching Outlook VBA for a couple weeks now and I haven't been able to quite complete the code I'm trying to put together.

Basically this is what I'm trying to do...
I want to select an email in the activeexplorer window, run a vba macro that will search the body of the email for a number in one of the following formats 123456789 or 123456789-012, it won't always be these numbers, just these formats. after the number is pulled into a string variable I'm going to move the email to another pre-defined folder, and write a .dat file with someinformation including the ID number from the body. Here's what my code looks like so far..

Sub MoveFiles()
'tracking variables
Dim cenumber As String
Dim namefile2
Dim logfile
Dim datestamp
Dim timestamp
Dim macronumber As String
Dim month
Dim year
Dim PID As String
'email variables
Dim objFolder As outlook.MAPIFolder
Dim objInbox As outlook.MAPIFolder
Dim objNS As outlook.NameSpace
Dim objItem As outlook.MailItem
Dim objMoved As outlook.MailItem
Dim messageBody As outlook.MailItem
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.Folders("Public Folders").Folders("All Public Folders
If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
Exit Sub
End If
If Application.ActiveExplorer.Selection.Count = 0 Then
    Exit Sub
    End If
For intX = ActiveExplorer.Selection.Count To 1 Step -1
Set objItem = ActiveExplorer.Selection.Item(intX)

The following is where I'm having my problem, I've tried using several variations including objItem.Body.Find and I can't get anything to complete this search in the body. The following code does work correctly if you run it from inside an open reply to a message, but won't work on a selected Item in the active explorer window. I've also found that I can return the entire body into a string, but I can't figure out how to make that do what I need either.
I believe the error I get is the Object Support error stating the object doesn't support the property. I just need to figure out how to run the Find search in a "selected" activeexplorer window item.

With objItem.find
    .text = "<[0-9]{9}[-][0-9]{3}>"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = True
    .MatchWildcards = True
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute FindText:="<[0-9]{9}[-][0-9]{3}>"
End With
    PID = Selection.text

After this previous section the code works fine.

If objItem.Class = olMail Then
Set objMoved = objItem.Move(objFolder)
End If
Next
        'Tracking system
'------------------------------------------------------------------------
  datestamp = CVar(Date)
  timestamp = CVar(Time)
  datestamp = Format(datestamp, "mm/dd/yyyy")
  timestamp = Format(timestamp, "hh:mm:ss")
  month = Left(datestamp, 2)
  year = Right(datestamp, 4)
       On Error Resume Next
       
'Access existing file on C: drive for name
'-----------------------------------------
        namefile2 = "C:\Program Files\E!PC\Schemes\ENU\examinerinfo.dat"
        Open namefile2 For Input As #1
        Input #1, cenumber
        Close #1
If cenumber = "" Then
   Dim filename
   Dim msgtext
   msgtext = "Enter your Examiner number (5 digit):"
   cenumber = InputBox$(msgtext, "Enter CE Number", , 200, 135)
        If cenumber = "" Then
           MsgBox ("You must enter your examiner number.")
           Exit Sub
        Else
           Namefile = "C:\Program Files\E!PC\Schemes\ENU\examinerinfo.dat"
           Open Namefile For Output As #1
           Write #1, cenumber
           Close #1
        End If
Else

End If
'writes to ce logfile
Namefile = "S:\Dental Claims Dept Access\DataTrack\DAT FILES\" & cenumber & ".logfile." & month & "-" & year & ".dat"
         Open Namefile For Append As #1
         Write #1, cenumber, timestamp, datestamp, macronumber
         Close #1
'End Tracking system
'----------------------------------------------------------
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objMoved = Nothing
End Sub

Thanks everyone in advance for your time in reviewing this.

 

[MakeItSo]

Hi Mr. True,

The Outlook ".find" method does not support regular expressions.
Add a reference to VbScript 5.5 regular expressions, assign the mail body to a string and parse it:

Sub PatternMatch()
Dim objItem As MailItem
Dim sStr As String
Dim re As VBScript_RegExp_55.RegExp

Set re = New VBScript_RegExp_55.RegExp
re.Pattern = ".*([0-9]{9}|[0-9]{9}-[0-9]{3})+.*"

Set objItem = ActiveInspector.CurrentItem
sStr = objItem.Body

If re.Test(sStr) Then
    MsgBox "Gotcha!"
End If

End Sub

Hope this helps!


Cheers,
MiS

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[MrTrue]

MiS,

Thank you so much for your feedback, I was able to implement a variation of your suggestion using the VBS 5.5 RegEx, and it worked perfectly. I've only been using VBA for about 6 months now and this forum and people like you have been critical in my learning process. Great work once again, and keep up the great work helping us Newbies in need of guidance!!!

When I get a chance I'll post the full function version for any else who may encounter this and need an example to work from.

 

[MakeItSo]

That's great to hear!
Glad you got it sorted!


[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell