Extract parts from Outlook email subject and then find it in an Excel spreadsheet

[sneakymist]

Hi everyone,

I have an email subject that looks like this:
RE: Blah blah - Blah blah, 1234-56, Blah blah blah

I was wondering how to extract "1234-56" from the email subject.

I tried:

If myemail.Subject Like "****-**" Then

But that only gives me true/false and I want the actual data, 1234-56.

Additionally, I was hoping to use the find function on my spreadsheet to find where the data is located.

So for example, since the email subject contains 1234-56, I will go on my spreadsheet and use the find function to find "1234-56".

I tried:

Cells.Find( _
What:=myemail.Subject, _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False).Activate

but I don't think that's the correct syntax.

Thanks in advance for the help!

 

[Worf]

Hi

See examples below:

' Excel module
Sub TextFinder()


' you know only the pattern
MsgBox Range("a:a").Find("????-??", [a1], xlValues, xlPart).Address


' you know the string
MsgBox Range("a:a").Find("1234-56", [a1], xlValues, xlPart).Address
End Sub

************************************************************

' Outlook module
Sub Test()
Dim v, o As MailItem
Set o = GetCurrentItem
v = TestRegExp(o.Subject)
End Sub


Function TestRegExp(s$)
' add a reference to Microsoft VBScript Regular Expressions 5.5
Dim objRegExp As RegExp, objMatch As Match, cm As MatchCollection
Set objRegExp = New RegExp
objRegExp.Pattern = "\d{4}[-]\d{2}"      ' things like 1234-56
objRegExp.IgnoreCase = True
objRegExp.Global = True
If (objRegExp.Test(s) = True) Then
    Set cm = objRegExp.Execute(s)
    For Each objMatch In cm
        MsgBox objMatch.Value           ' displays the string
    Next
End If
End Function


Function GetCurrentItem() As Object
Dim olApp As Outlook.Application
Set olApp = Application
Select Case TypeName(olApp.ActiveWindow)
    Case "Explorer"
        Set GetCurrentItem = olApp.ActiveExplorer.Selection.Item(1)
    Case "Inspector"
        Set GetCurrentItem = olApp.ActiveInspector.CurrentItem
End Select
Set olApp = Nothing
End Function