Change subject line to [table lookup]

I want to create a script that is called by a rule that takes the string of the subject line and finds the record in a (table?) somewhere and returns a value corresponding to the record that was found.

To be more specific, I have faxes that are being converted into e-mail, which in the subject line contains the fax #. I would like to do a lookup of some kind to a table that stores the fax #'s and corresponding store location. The result being the subject line gets changed from the fax # to the store location.

I am experienced with VBA in Excel and Access, but have not used it in Outlook before.

Thank you
LVL 1
wipnavAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
Chris BottomleyConnect With a Mentor Commented:
As a starter ... the following script should be called from your rule for incoming messages.  It uses a file of the form as supplied which needs to be saved to your PC and the correct path and filename used to replace:

Const strWBName As String = "C:\deleteme\Fax2Store.xls"

That said the incoming mail subjects should then be edited with the appropriate value from column 2

Chris
Sub Q_26849002(mai As MailItem)
Dim strFaxNumber As String
Dim xlApp As Object
Dim xlwb As Object
Dim xlws As Object
Dim rng As Object
Dim var As Variant
Const strWBName As String = "C:\deleteme\Fax2Store.xls"
Const xlwhole As Integer = 1

    With mai
        If RegExp.valDatabyRegEx(mai.Subject, "[0-9]-[0-9]{3}-[0-9]{3}-[0-9]{4}") Then
            ' It's a FAX number so ...
            strFaxNumber = RegExp.getDatabyRegEx(Application.ActiveInspector.CurrentItem.Subject, "[0-9]-[0-9]{3}-[0-9]{3}-[0-9]{4}")(0)
            'Look it up in the excel data
            If xlApp Is Nothing Then
                Set xlApp = CreateObject("excel.application")
            End If
            If xlwb Is Nothing Then
                For Each var In xlApp.Workbooks
                    If var.FullName = strWBName Then
                        Set xlwb = var
                        Exit For
                    End If
                Next
            End If
            If xlwb Is Nothing Then Set xlwb = xlApp.Workbooks.Open(strWBName)
            Set xlws = xlwb.Sheets("Sheet1")
            Set rng = xlws.Range("A:A").Find(What:=strFaxNumber, LookAt:=xlwhole, MatchCase:=False, SearchFormat:=False)
            mai.Subject = Replace(mai.Subject, strFaxNumber, rng.Offset(0, 1))
            mai.Save
            xlwb.Close
            xlApp.Quit
        Else
            'Do Nothing
        End If
    End With
End Sub

Open in new window

0
 
Chris BottomleyCommented:
We can certainly help ... it depends on where you want to master it from ... is the table in access and do you want to trigger off an incoming email or will you want to pick up a specific email for processing.

Chris
0
 
wipnavAuthor Commented:
The table could be stored anywhere (access, excel, txt). I would like to trigger this off an incoming e-mail.
0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

 
Chris BottomleyCommented:
Keying to my strengths then excel would be the easiest for me to integrate so can you provide a sample of an excel file structure you would use ... i.e. is it only Fax number and store location in the 'table'.

An example if one exists is best but if not it's easy enough to create the initial file for the purpose.

Chris
0
 
wipnavAuthor Commented:
Hey Chris,

I don't have the list of all of the fax numbers and store locations populated yet. The table structure would simply be Fax # and store location columns.

Thanks for your help,

Steve
0
 
Chris BottomleyCommented:
That's fine i'll test an outline and supply the file.

In regard to a script to run from a rule ... can you define what a fax number will look like ... prefix or anything else and what punctuation needs to be considered.  Basically I need to recognise a fax number for example as different from (for example) a telephone or order number.

Chris
0
 
wipnavAuthor Commented:
The fax numbers come in as "1-123-456-7890". The fax # e-mails will be the only type of e-mail being sent to this e-mail address so we don't have to restrict the rule to execute only under certain conditions.
0
 
wipnavAuthor Commented:
This works great! I am just calling this procedure as a script from the advanced rules settings and it changes the subject line to the correct location. Thanks for your help, A++.

Steve
0
 
Chris BottomleyCommented:
For purposes of general usage ... the library routines used are as below ... they were used from a library module called regexp hence the regexp prefix but if used in the same code module as the Q_26849002 sub then no prefix is necessary.

Steve

My apologies for the assumption ... I should have been more explicit.

Chris
Function getDatabyRegEx(strFindin As String, strPattern As String, Optional strReplacement As String = "", Optional bolGlobalReplace As Boolean = True, Optional bolMatchCase As Boolean = False) As Variant
Dim colmatch As Object
Dim itm As Variant
Dim retArray() As String
Dim intBounds As Integer

    intBounds = -1
    If valDatabyRegEx(strFindin, strPattern, bolMatchCase) Then
        With CreateObject("vbscript.regexp")
            .IgnoreCase = Not bolMatchCase
            .Global = bolGlobalReplace
            .Pattern = strPattern
            Set colmatch = .Execute(strFindin)
            If bolGlobalReplace Then
                For Each itm In colmatch
                    intBounds = intBounds + 1
                    ReDim Preserve retArray(0 To intBounds)
                    retArray(intBounds) = itm
                Next
            Else
                ReDim retArray(0)
                retArray(0) = colmatch(0)
            End If
        End With
        getDatabyRegEx = retArray
    Else
        getDatabyRegEx = Array("")
    End If
    
End Function

Function valDatabyRegEx(strFindin As String, strPattern As String, Optional bolMatchCase As Boolean = False) As Boolean
    
    With CreateObject("vbscript.regexp")
        .IgnoreCase = Not bolMatchCase
        .Pattern = strPattern
        valDatabyRegEx = .test(strFindin) = True
    End With
    
End Function

Open in new window

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.