Link to home
Start Free TrialLog in
Avatar of bsharath
bsharathFlag for India

asked on

Outlook macro to save email body data into seperate colums in excel.

Hi,

Outlook macro to save email body data into seperate colums in excel.
I will have this data in the subject to identify "Employee departure notice:"

I need to run it on a folder or be able to add this code to all emails that arrive.
Each day new excel file should be created.

The body of the email will be as this

The person noted here is leaving the organisation on 12/11/2010.

Employee:  Paul, Andrew (IN190924) Job Title:  Software Engineer Office location:  USA
Manager:  John, Raj


I want each of these in each colum

Andrew Paul | IN190924 | Software Engineer | USA | Raj John

The excel should look as above.

regards
sharath
Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Is the new daily file to be the same name or can we incorporate the date into the file name?
Avatar of bsharath

ASKER

Hi Chris
We can have date as the file name

Poorly phrased ... it's easier if we create a new file ... but whatever you want if you have a preference.

Chris

yes Chris
I want the file named as "DD-MM-YYY-Email"
each day 1 file to be created. as and when an email comes in it has to update into it.

When selected a folder and run has to save into the same dated file if already available
ON initial consideration whilst commonly I use the one file for both rule based processing and another for folder based in this case I suggest two scripts for efficiency to avoid overheads with repeated closure of the file and/or passing a workbook parameter.

If that's ok ... the essential processing will be the same of course

Chris
Q_26485542 run from a rule.

Sub Q_26485542a() to run on a folder via pickfolder

filename is declared in both Q_26485542 & Q_26485542a
as
    fn = "c:\deleteme\Q_26485542 " & Format(Now(), "dd mmm yyyy") & ".xlsx"


Chris
Sub Q_26485542(mai As MailItem)
Dim fn As String
Dim xlapp As Object
Dim wb As Object
    
    fn = "c:\deleteme\Q_26485542 " & Format(Now(), "dd mmm yyyy") & ".xlsx"
    Set xlapp = CreateObject("excel.application")
    On Error Resume Next
    Set wb = xlapp.workbooks.Open(fn)
    On Error GoTo 0
    If wb Is Nothing Then
        Set wb = xlapp.workbooks.Add
        wb.sheets(1).Range("A1") = "Employee"
        wb.sheets(1).Range("B1") = "ID"
        wb.sheets(1).Range("C1") = "Job Title"
        wb.sheets(1).Range("D1") = "Nation"
        wb.sheets(1).Range("E1") = "Manager"
        wb.saveas fn
    End If
    Q_26485542b mai, wb
    wb.Close True
    xlapp.Quit

End Sub
Sub Q_26485542a()
Dim fn As String
Dim xlapp As Object
Dim wb As Object
    
    fn = "c:\deleteme\Q_26485542 " & Format(Now(), "dd mmm yyyy") & ".xlsm"
    Set xlapp = CreateObject("excel.application")
    On Error Resume Next
    Set wb = xlapp.workbooks.Open(fn)
    On Error GoTo 0
    If wb Is Nothing Then
        Set wb = xlapp.workbooks.Add
        wb.sheets(1).Range("A1") = "Employee"
        wb.sheets(1).Range("B1") = "ID"
        wb.sheets(1).Range("C1") = "Job Title"
        wb.sheets(1).Range("D1") = "Nation"
        wb.sheets(1).Range("E1") = "Manager"
        wb.saveas fn
    End If
    For Each mai In Application.Session.PickFolder.items
        If mai.Class = olMail Then
            Q_26485542b mai, wb
        End If
    Next
    wb.Close True
    xlapp.Quit

End Sub

Sub Q_26485542b(mai As MailItem, wb As Object)
Dim ln As Variant
Dim arr() As String
Dim str As String
Dim rw As Long
Static regex As Object
Const xlup As Integer = -4162
    
    If InStr(LCase(mai.body), LCase("The person noted here is leaving the organisation on")) = 0 Then Exit Sub
    If regex Is Nothing Then Set regex = CreateObject("vbscript.regexp")
    rw = wb.sheets(1).Range("A" & wb.sheets(1).Rows.count).End(xlup).Row + 1
    For Each ln In Split(Replace(mai.body, Chr(160), " "), vbCrLf)
' Employee
        If valDatabyRegEx(CStr(ln), "(Employee: *)([a-z]*)(, *)([a-z]*)( *\(.*)") Then
            With regex
                .Pattern = "(Employee: *)([a-z]*)(, *)([a-z]*)( *\(.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$4 $2")
            wb.sheets(1).Range("A" & rw) = Trim(str)
        End If
' ID
        If valDatabyRegEx(CStr(ln), "(.*\()(IN[0-9]*)(\).*)") Then
            With regex
                .Pattern = "(.*\()(IN[0-9]*)(\).*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$2")
            wb.sheets(1).Range("B" & rw) = Trim(str)
        End If
' Job Title
        If valDatabyRegEx(CStr(ln), "(.*Job Title: *)([a-z -_]*)(\r\n|office location:).*") Then
            With regex
                .Pattern = "(.*Job Title: *)([a-z -_]*)(\r\n|office location:.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$2")
            wb.sheets(1).Range("C" & rw) = Trim(str)
        End If
' Nation
        If valDatabyRegEx(CStr(ln), "(.*)(office location: *)([a-z _-]*)(.*)") Then
            With regex
                .Pattern = "(.*)(office location: *)([a-z _-]*)(.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$3")
            wb.sheets(1).Range("D" & rw) = Trim(str)
        End If
' Manager
        If valDatabyRegEx(CStr(ln), "(manager: *)([a-z -_]*)(.*)") Then
            With regex
                .Pattern = "(manager: *)([a-z -_]*)(.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$2")
            arr = Split(str, ",")
            wb.sheets(1).Range("E" & rw) = Trim(arr(1)) & " " & Trim(arr(0))
        End If
    Next

End Sub

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

Hi Chris i get this

---------------------------
Microsoft Visual Basic
---------------------------
Compile error:

ByRef argument type mismatch
---------------------------
OK   Help  
---------------------------
Under what circumstances and where?
When i run the macro on a folder i get the error and this line is selected

 Q_26485542b mai, wb
Found a couple of errors in the pickfolder approach ... which I hadn't tested so apologies there.

Chris
Sub Q_26485542(mai As MailItem)
Dim fn As String
Dim xlapp As Object
Dim wb As Object
    
    fn = "c:\deleteme\Q_26485542 " & Format(Now(), "dd mmm yyyy") & ".xlsx"
    Set xlapp = CreateObject("excel.application")
    On Error Resume Next
    Set wb = xlapp.workbooks.Open(fn)
    On Error GoTo 0
    If wb Is Nothing Then
        Set wb = xlapp.workbooks.Add
        wb.sheets(1).Range("A1") = "Employee"
        wb.sheets(1).Range("B1") = "ID"
        wb.sheets(1).Range("C1") = "Job Title"
        wb.sheets(1).Range("D1") = "Nation"
        wb.sheets(1).Range("E1") = "Manager"
        wb.saveas fn
    End If
    Q_26485542b mai, wb
    wb.Close True
    xlapp.Quit

End Sub
Sub Q_26485542a()
Dim fn As String
Dim mai As Object
Dim xlapp As Object
Dim wb As Object
    
    fn = "c:\deleteme\Q_26485542 " & Format(Now(), "dd mmm yyyy") & ".xlsx"
    Set xlapp = CreateObject("excel.application")
    On Error Resume Next
    Set wb = xlapp.workbooks.Open(fn)
    On Error GoTo 0
    If wb Is Nothing Then
        Set wb = xlapp.workbooks.Add
        wb.sheets(1).Range("A1") = "Employee"
        wb.sheets(1).Range("B1") = "ID"
        wb.sheets(1).Range("C1") = "Job Title"
        wb.sheets(1).Range("D1") = "Nation"
        wb.sheets(1).Range("E1") = "Manager"
        wb.saveas fn
    End If
    For Each mai In Application.Session.PickFolder.items
        If mai.Class = olMail Then
            Q_26485542b mai, wb
        End If
    Next
    wb.Close True
    xlapp.Quit

End Sub

Sub Q_26485542b(mai As MailItem, wb As Object)
Dim ln As Variant
Dim arr() As String
Dim str As String
Dim rw As Long
Static regex As Object
Const xlup As Integer = -4162
    
    If InStr(LCase(mai.body), LCase("The person noted here is leaving the organisation on")) = 0 Then Exit Sub
    If regex Is Nothing Then Set regex = CreateObject("vbscript.regexp")
    rw = wb.sheets(1).Range("A" & wb.sheets(1).Rows.count).End(xlup).Row + 1
    For Each ln In Split(Replace(mai.body, Chr(160), " "), vbCrLf)
' Employee
        If valDatabyRegEx(CStr(ln), "(Employee: *)([a-z]*)(, *)([a-z]*)( *\(.*)") Then
            With regex
                .Pattern = "(Employee: *)([a-z]*)(, *)([a-z]*)( *\(.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$4 $2")
            wb.sheets(1).Range("A" & rw) = Trim(str)
        End If
' ID
        If valDatabyRegEx(CStr(ln), "(.*\()(IN[0-9]*)(\).*)") Then
            With regex
                .Pattern = "(.*\()(IN[0-9]*)(\).*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$2")
            wb.sheets(1).Range("B" & rw) = Trim(str)
        End If
' Job Title
        If valDatabyRegEx(CStr(ln), "(.*Job Title: *)([a-z -_]*)(\r\n|office location:).*") Then
            With regex
                .Pattern = "(.*Job Title: *)([a-z -_]*)(\r\n|office location:.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$2")
            wb.sheets(1).Range("C" & rw) = Trim(str)
        End If
' Nation
        If valDatabyRegEx(CStr(ln), "(.*)(office location: *)([a-z _-]*)(.*)") Then
            With regex
                .Pattern = "(.*)(office location: *)([a-z _-]*)(.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$3")
            wb.sheets(1).Range("D" & rw) = Trim(str)
        End If
' Manager
        If valDatabyRegEx(CStr(ln), "(manager: *)([a-z -_]*)(.*)") Then
            With regex
                .Pattern = "(manager: *)([a-z -_]*)(.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$2")
            arr = Split(str, ",")
            wb.sheets(1).Range("E" & rw) = Trim(arr(1)) & " " & Trim(arr(0))
        End If
    Next

End Sub

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

When i run the 2nd time i get subscript out of range
When debug goes here
            wb.Sheets(1).Range("E" & rw) = Trim(arr(1)) & " " & Trim(arr(0))
And what does the relevant email show ... it looks as though the names are not seperated by a comma

Chris
The following adaption checks for the comma, if not found trys a space seperator and if still not found simply returns whatever is or is not there ... hopefully

Chris
Sub Q_26485542(mai As MailItem)
Dim fn As String
Dim xlapp As Object
Dim wb As Object
    
    fn = "c:\deleteme\Q_26485542 " & Format(Now(), "dd mmm yyyy") & ".xlsx"
    Set xlapp = CreateObject("excel.application")
    On Error Resume Next
    Set wb = xlapp.workbooks.Open(fn)
    On Error GoTo 0
    If wb Is Nothing Then
        Set wb = xlapp.workbooks.Add
        wb.sheets(1).Range("A1") = "Employee"
        wb.sheets(1).Range("B1") = "ID"
        wb.sheets(1).Range("C1") = "Job Title"
        wb.sheets(1).Range("D1") = "Nation"
        wb.sheets(1).Range("E1") = "Manager"
        wb.saveas fn
    End If
    Q_26485542b mai, wb
    wb.Close True
    xlapp.Quit

End Sub
Sub Q_26485542a()
Dim fn As String
Dim mai As Object
Dim xlapp As Object
Dim wb As Object
    
    fn = "c:\deleteme\Q_26485542 " & Format(Now(), "dd mmm yyyy") & ".xlsx"
    Set xlapp = CreateObject("excel.application")
    On Error Resume Next
    Set wb = xlapp.workbooks.Open(fn)
    On Error GoTo 0
    If wb Is Nothing Then
        Set wb = xlapp.workbooks.Add
        wb.sheets(1).Range("A1") = "Employee"
        wb.sheets(1).Range("B1") = "ID"
        wb.sheets(1).Range("C1") = "Job Title"
        wb.sheets(1).Range("D1") = "Nation"
        wb.sheets(1).Range("E1") = "Manager"
        wb.saveas fn
    End If
    For Each mai In Application.Session.PickFolder.items
        If mai.Class = olMail Then
            Q_26485542b mai, wb
        End If
    Next
    wb.Close True
    xlapp.Quit

End Sub

Sub Q_26485542b(mai As MailItem, wb As Object)
Dim ln As Variant
Dim arr() As String
Dim str As String
Dim rw As Long
Static regex As Object
Const xlup As Integer = -4162
    
    If InStr(LCase(mai.body), LCase("The person noted here is leaving the organisation on")) = 0 Then Exit Sub
    If regex Is Nothing Then Set regex = CreateObject("vbscript.regexp")
    rw = wb.sheets(1).Range("A" & wb.sheets(1).Rows.count).End(xlup).Row + 1
    For Each ln In Split(Replace(mai.body, Chr(160), " "), vbCrLf)
' Employee
        If valDatabyRegEx(CStr(ln), "(Employee: *)([a-z]*)(, *)([a-z]*)( *\(.*)") Then
            With regex
                .Pattern = "(Employee: *)([a-z]*)(, *)([a-z]*)( *\(.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$4 $2")
            wb.sheets(1).Range("A" & rw) = Trim(str)
        End If
' ID
        If valDatabyRegEx(CStr(ln), "(.*\()(IN[0-9]*)(\).*)") Then
            With regex
                .Pattern = "(.*\()(IN[0-9]*)(\).*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$2")
            wb.sheets(1).Range("B" & rw) = Trim(str)
        End If
' Job Title
        If valDatabyRegEx(CStr(ln), "(.*Job Title: *)([a-z -_]*)(\r\n|office location:).*") Then
            With regex
                .Pattern = "(.*Job Title: *)([a-z -_]*)(\r\n|office location:.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$2")
            wb.sheets(1).Range("C" & rw) = Trim(str)
        End If
' Nation
        If valDatabyRegEx(CStr(ln), "(.*)(office location: *)([a-z _-]*)(.*)") Then
            With regex
                .Pattern = "(.*)(office location: *)([a-z _-]*)(.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$3")
            wb.sheets(1).Range("D" & rw) = Trim(str)
        End If
' Manager
        If valDatabyRegEx(CStr(ln), "(manager: *)([a-z -_]*)(.*)") Then
            With regex
                .Pattern = "(manager: *)([a-z -_]*)(.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$2")
            arr = Split(str, ",")
            If UBound(arr) = 1 Then
                arr = Split(str, " ")
                If UBound(arr) = 1 Then
                    wb.sheets(1).Range("E" & rw) = Trim(str)
                Else
                    wb.sheets(1).Range("E" & rw) = Trim(arr(1)) & " " & Trim(arr(0))
                End If
            Else
                wb.sheets(1).Range("E" & rw) = Trim(arr(1)) & " " & Trim(arr(0))
            End If
        End If
    Next

End Sub

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

Chris i still get subscript out of range
when debug goes here
                wb.Sheets(1).Range("E" & rw) = Trim(arr(1)) & " " & Trim(arr(0))
And to try and fix it I still need ... what does the relevant email show ... it looks as though the names are not seperated by a comma

Chris
Chris how can i find which email
I emailed you 2 emails that will look as
When the code breaks type in the immediate window:

mai.getinspector.activate

Should open up the specific email

Chris
I have this in the body

The person noted here is leaving the organisation on 30/09/2010.

Employee:  Kur, Amar (IN1898949) Job Title:  
Office location:  
Manager:  

and subject as this
Employee departure notice: IN - Kur, Amar (WorkflowID=77877876)
Ah so manager, office location AND job title are completely blank!

Let me rething this change.

Chris
On a quick check it's only the name that causes the problem so try this

Chris
Sub Q_26485542(mai As MailItem)
Dim fn As String
Dim xlapp As Object
Dim wb As Object
    
    fn = "c:\deleteme\Q_26485542 " & Format(Now(), "dd mmm yyyy") & ".xlsx"
    Set xlapp = CreateObject("excel.application")
    On Error Resume Next
    Set wb = xlapp.workbooks.Open(fn)
    On Error GoTo 0
    If wb Is Nothing Then
        Set wb = xlapp.workbooks.Add
        wb.sheets(1).Range("A1") = "Employee"
        wb.sheets(1).Range("B1") = "ID"
        wb.sheets(1).Range("C1") = "Job Title"
        wb.sheets(1).Range("D1") = "Nation"
        wb.sheets(1).Range("E1") = "Manager"
        wb.saveas fn
    End If
    Q_26485542b mai, wb
    wb.Close True
    xlapp.Quit

End Sub
Sub Q_26485542a()
Dim fn As String
Dim mai As Object
Dim xlapp As Object
Dim wb As Object
    
    fn = "c:\deleteme\Q_26485542 " & Format(Now(), "dd mmm yyyy") & ".xlsx"
    Set xlapp = CreateObject("excel.application")
    On Error Resume Next
    Set wb = xlapp.workbooks.Open(fn)
    On Error GoTo 0
    If wb Is Nothing Then
        Set wb = xlapp.workbooks.Add
        wb.sheets(1).Range("A1") = "Employee"
        wb.sheets(1).Range("B1") = "ID"
        wb.sheets(1).Range("C1") = "Job Title"
        wb.sheets(1).Range("D1") = "Nation"
        wb.sheets(1).Range("E1") = "Manager"
        wb.saveas fn
    End If
    For Each mai In Application.Session.PickFolder.items
        If mai.Class = olMail Then
            Q_26485542b mai, wb
        End If
    Next
    wb.Close True
    xlapp.Quit

End Sub

Sub Q_26485542b(mai As MailItem, wb As Object)
Dim ln As Variant
Dim arr() As String
Dim str As String
Dim rw As Long
Static regex As Object
Const xlup As Integer = -4162
    
    If InStr(LCase(mai.body), LCase("The person noted here is leaving the organisation on")) = 0 Then Exit Sub
    If regex Is Nothing Then Set regex = CreateObject("vbscript.regexp")
    rw = wb.sheets(1).Range("A" & wb.sheets(1).Rows.count).End(xlup).Row + 1
    For Each ln In Split(Replace(mai.body, Chr(160), " "), vbCrLf)
' Employee
        If valDatabyRegEx(CStr(ln), "(Employee: *)([a-z]*)(, *)([a-z]*)( *\(.*)") Then
            With regex
                .Pattern = "(Employee: *)([a-z]*)(, *)([a-z]*)( *\(.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$4 $2")
            wb.sheets(1).Range("A" & rw) = Trim(str)
        End If
' ID
        If valDatabyRegEx(CStr(ln), "(.*\()(IN[0-9]*)(\).*)") Then
            With regex
                .Pattern = "(.*\()(IN[0-9]*)(\).*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$2")
            wb.sheets(1).Range("B" & rw) = Trim(str)
        End If
' Job Title
        If valDatabyRegEx(CStr(ln), "(.*Job Title: *)([a-z -_]*)(\r\n|office location:).*") Then
            With regex
                .Pattern = "(.*Job Title: *)([a-z -_]*)(\r\n|office location:.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$2")
            wb.sheets(1).Range("C" & rw) = Trim(str)
        End If
' Nation
        If valDatabyRegEx(CStr(ln), "(.*)(office location: *)([a-z _-]*)(.*)") Then
            With regex
                .Pattern = "(.*)(office location: *)([a-z _-]*)(.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$3")
            wb.sheets(1).Range("D" & rw) = Trim(str)
        End If
' Manager
        If valDatabyRegEx(CStr(ln), "(manager: *)([a-z -_]*)(.*)") Then
            With regex
                .Pattern = "(manager: *)([a-z -_]*)(.*)"
                .Global = False
                .IgnoreCase = True
            End With
            str = regex.Replace(ln, "$2")
            arr = Split(str, ",")
            If Abs(UBound(arr)) = 1 Then
                arr = Split(str, " ")
                If Abs(UBound(arr)) = 1 Then
                    wb.sheets(1).Range("E" & rw) = Trim(str)
                Else
                    wb.sheets(1).Range("E" & rw) = Trim(arr(1)) & " " & Trim(arr(0))
                End If
            Else
                wb.sheets(1).Range("E" & rw) = Trim(arr(1)) & " " & Trim(arr(0))
            End If
        End If
    Next

End Sub

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

Thanks all fine
2 issues
1. If a file is already available with same date it does not get updated into it rather asks to save in new file.
2. I have this in the body "The person noted here is leaving the organisation on 10/09/2010."

i want the date into a colum and the email received date as well
1. HAve you got the file open?

2. Already chedcking for this so what's the problem

3. Which data into a column, and adding a date can do - received date?

Chris
1. When i ran the macro 2nd time it asked me to save the file as "Copy of Q_26485542 21 Sep 2010"

2. In this line i have the date we need to get the date also.

3. Received date in a colum and another colum the date in this line. "The person noted here is leaving the organisation on 10/09/2010."
ASKER CERTIFIED SOLUTION
Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks Chris works perfect
Chris when i need to create a rule to run on mail arrival. I cannot see the macro
is there anything i need to change
Should be:

Q_26485542

Chris
but i dont get them shown in the rule when i click the script to create one
As I say Q_26485542 is it ... you should have the parameter mai as mailitem therein.  I have double checked it shows for me ... you do have it in a normal code module .... and only one copy - try searching for the string ... but the a and b affixes are of course different subs.

Chris
Thanks Chris i had duplicate codes in 2 modules. Now it works
THanks, and I do appreciate your coming back to say it's resolved.

Chris