Public Sub Subject()
Dim obj As Object
Dim Sel As Outlook.Selection
Dim DoSave As Boolean
Dim NewSubject As String
If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
Set obj = Application.ActiveInspector.CurrentItem
Else
Set Sel = Application.ActiveExplorer.Selection
If Sel.Count Then
Set obj = Sel(1)
DoSave = True
End If
End If
If Not obj Is Nothing Then
stringsearch (obj.Subject)
End If
End Sub
Function stringsearch(stext As String)
Dim result As Variant
Dim member As Variant
Dim found As Boolean
Dim Regex As Object
found = False
Set Regex = CreateObject("Vbscript.Regexp")
With Regex
.Pattern = "\d[a-zA-Z]{4}\d{4}"
.IgnoreCase = False
.Global = True
If .test(stext) Then found = True
Set result = .Execute(stext)
End With
Set Regex = Nothing
If found = True Then
For Each member In result
MsgBox "you got a hit!" & Chr(10) & member
Next member
Else
MsgBox "IDIOT!"
End If
Set result = Nothing
End Function