Hi Diane,
Nice to meet you, I'm new here at the forum. I need your help regarding a task I've been assigned to extract certain text from an Outlook Email Message when it arrives through inbox to a specific folder. I followed your directions as best as I can on your Blog post "slipstick.com to extract the following information but had some difficulty:
Please view if I've coded the information correctly to retrieve the information, Thanks Diane I appreciate your help.
Sub GetValueUsingRegEx()
Dim olMail As Outlook.MailItem
Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim M As Match
Dim strSubject As String
Dim testSubject As String
Set olMail = Application.ActiveExplorer().Selection(1)
Set Reg1 = New RegExp
For i = 1 To 15
With Reg1
Select Case i
Case 1
.Pattern = "(Title[:]([\w-\s]*)\s*)\n"
.Global = False
Case 2
.Pattern = "(First Name[:]([\w-\s]*)\s*)\n"
.Global = False
Case 3
.Pattern = "(Last Name[:]([\w-\s]*)\s*)\n"
.Global = False
Case 4
.Pattern = "(Address[:]([\w-\s]*)\s*)\n"
.Global = False
Case 5
.Pattern = "(City[:]([\w-\s]*)\s*)\n"
.Global = False
Case 6
.Pattern = "(Province[:]([\w-\s]*)\s*)\n"
.Global = False
Case 7
.Pattern = "(Postal Code[:]([\w-\s]*)\s*)\n"
.Global = False
Case 8
.Pattern = "(Phone Number[:]([\w-\s]*)\s*)\n"
.Global = False
Case 9
.Pattern = "(Email Address[:]([\w-\s]*)\s*)\n"
.Global = False
Case 10
.Pattern = "(Age Range[:]([\w-\s]*)\s*)\n"
.Global = False
Case 11
.Pattern = "(Do You Have A Spouse or Partner?[:]([\w-\s]*)\s*)\n"
.Global = False
Case 12
.Pattern = "(Number of dependants[:]([\w-\s]*)\s*)\n"
.Global = False
Case 13
.Pattern = "(Free online course[:]([\w-\s]*)\s*)\n"
.Global = False
Case 14
.Pattern = "(My renewal within the next[:]([\w-\s]*)\s*)\n"
.Global = False
Case 15
.Pattern = "(Like to have an professsional evaluation ?[:]([\w-\s]*)\s*)\n"
.Global = False
Case 15
.Pattern = "(([\d]*\.[\d]*))\s*\n"
.Global = False
End Select
End With
If Reg1.Test(olMail.Body) Then
Set M1 = Reg1.Execute(olMail.Body)
For Each M In M1
Debug.Print M.SubMatches(1)
strSubject = M.SubMatches(1)
strSubject = Replace(strSubject, Chr(13), "")
testSubject = testSubject & "; " & Trim(strSubject)
Debug.Print i & testSubject
Next
End If
Next i
Debug.Print olMail.Subject & testSubject
olMail.Subject = olMail.Subject & testSubject
olMail.Save
Set Reg1 = Nothing
End Sub
Nice to meet you, I'm new here at the forum. I need your help regarding a task I've been assigned to extract certain text from an Outlook Email Message when it arrives through inbox to a specific folder. I followed your directions as best as I can on your Blog post "slipstick.com to extract the following information but had some difficulty:
Please view if I've coded the information correctly to retrieve the information, Thanks Diane I appreciate your help.
Sub GetValueUsingRegEx()
Dim olMail As Outlook.MailItem
Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim M As Match
Dim strSubject As String
Dim testSubject As String
Set olMail = Application.ActiveExplorer().Selection(1)
Set Reg1 = New RegExp
For i = 1 To 15
With Reg1
Select Case i
Case 1
.Pattern = "(Title[:]([\w-\s]*)\s*)\n"
.Global = False
Case 2
.Pattern = "(First Name[:]([\w-\s]*)\s*)\n"
.Global = False
Case 3
.Pattern = "(Last Name[:]([\w-\s]*)\s*)\n"
.Global = False
Case 4
.Pattern = "(Address[:]([\w-\s]*)\s*)\n"
.Global = False
Case 5
.Pattern = "(City[:]([\w-\s]*)\s*)\n"
.Global = False
Case 6
.Pattern = "(Province[:]([\w-\s]*)\s*)\n"
.Global = False
Case 7
.Pattern = "(Postal Code[:]([\w-\s]*)\s*)\n"
.Global = False
Case 8
.Pattern = "(Phone Number[:]([\w-\s]*)\s*)\n"
.Global = False
Case 9
.Pattern = "(Email Address[:]([\w-\s]*)\s*)\n"
.Global = False
Case 10
.Pattern = "(Age Range[:]([\w-\s]*)\s*)\n"
.Global = False
Case 11
.Pattern = "(Do You Have A Spouse or Partner?[:]([\w-\s]*)\s*)\n"
.Global = False
Case 12
.Pattern = "(Number of dependants[:]([\w-\s]*)\s*)\n"
.Global = False
Case 13
.Pattern = "(Free online course[:]([\w-\s]*)\s*)\n"
.Global = False
Case 14
.Pattern = "(My renewal within the next[:]([\w-\s]*)\s*)\n"
.Global = False
Case 15
.Pattern = "(Like to have an professsional evaluation ?[:]([\w-\s]*)\s*)\n"
.Global = False
Case 15
.Pattern = "(([\d]*\.[\d]*))\s*\n"
.Global = False
End Select
End With
If Reg1.Test(olMail.Body) Then
Set M1 = Reg1.Execute(olMail.Body)
For Each M In M1
Debug.Print M.SubMatches(1)
strSubject = M.SubMatches(1)
strSubject = Replace(strSubject, Chr(13), "")
testSubject = testSubject & "; " & Trim(strSubject)
Debug.Print i & testSubject
Next
End If
Next i
Debug.Print olMail.Subject & testSubject
olMail.Subject = olMail.Subject & testSubject
olMail.Save
Set Reg1 = Nothing
End Sub