Email to send multiple times with different subject line

Hi All,

We're currently working to have a number of personal records stored digitally, rather than as a paper record. One of the processes for this will involve software reading the heading in emails and then sending it on to a folder in our record keeping system. The problem is that the system isn't clever enough to know that some records refer to multiple people and so need to be sent to multiple folders.

Right now our solution is to manually forward the email multiple times, and if we have 50 employees in one record, we need to forward the email 50 times, adjusting the subject line each time (so each includes the individual employee ID).

Is there a way to automate this? I had thought something along the lines of placing all the relevant employee numbers in an excel spreadsheet, then run a script that will send the email 50 times to a dedicated inbox with a different subject line for each one. The subject line will have three sections look something like this:

Employee ID - Position Change - 13/05/2019,
or this
Employee ID - Tax Update - 15/07/2020

and so the Employee ID would change, but the rest of the subject heading would remain the same.


Anyone have any thoughts on a way to make this work?

The problem with this is that you haven't indicated what a 'record' is and where it is stored. In order to automate this the macro would need to be able to determine which employees related to they 'record' associated with that e-mail message. Certainly that information is not available from the message subjects you have described.

If the macro has that information then what's the point of forwarding the message to various people if you merely want a copy of the message in the appropriate folder? Do the recipients associated with the 'record' actually require the e-mail of is it just a filing exercise?

It's just a filing exercise. I want to send the email multiple times to the same mailbox, with the only change being a different employee ID in the subject heading

Our software will poll this mailbox, read the subject line, and then send the email to the correct folder our electronic filing system automatically.

OK, that part is easy enough, but it doesn't answer the question how the macro would know which IDs are required for each message?

There would be an excel spreadsheet detailing all the employee numbers

Getting information from you is like drawing teeth! However the following assumes you have a workbook "C:\Path\IDList.xlsx" with worksheet ("Sheet1") with the employee numbers in column 1 and the recipient of the messages in column 2 and will forward the message to all the records, changing the subject each time. Use the test macro to test it with a message in your inbox or run it as a script from a rule. It will be better not to have Outlook set to send messages immediately while testing!

Code:

---

Option Explicit

Sub TestProcess()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    Distribute olMsg
lbl_Exit:
    Exit Sub
End Sub


Sub Distribute(olItem As MailItem)
Const strWorkbook As String = "C:\Path\IDList.xlsx"
Const strSheet As String = "Sheet1"
Dim vSubject As Variant
Dim sTo As String, sID As String
Dim strSubject As String
Dim olFwd As MailItem
Dim arr() As Variant
Dim i As Integer
    With olItem
        If TypeName(olItem) = "MailItem" Then
            vSubject = Split(.Subject, "-")
            If Not UBound(vSubject) = 2 Then GoTo lbl_Exit
            If Not IsDate(Trim(vSubject(2))) Then GoTo lbl_Exit
            arr = xlFillArray(strWorkbook, strSheet)
            For i = 0 To UBound(arr, 2)
                sID = arr(0, i)
                sTo = arr(1, i)
                Set olFwd = olItem.Forward
                strSubject = sID & " -" & vSubject(1) & "-" & vSubject(2)
                With olFwd
                    .Subject = strSubject
                    .To = sTo
                    .Display    'remove after testing
                    '.Send 'restore after testing
                End With
            Next i
        End If
    End With
lbl_Exit:
    Exit Sub
End Sub


Private Function xlFillArray(strWorkbook As String, _
                            strWorksheetName As String) As Variant
Dim RS As Object
Dim CN As Object
Dim iRows As Long


    strWorksheetName = strWorksheetName & "$]"
    Set CN = CreateObject("ADODB.Connection")
    CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                              "Data Source=" & strWorkbook & ";" & _
                              "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"


    Set RS = CreateObject("ADODB.Recordset")
    RS.Open "SELECT * FROM [" & strWorksheetName, CN, 2, 1


    With RS
        .MoveLast
        iRows = .RecordCount
        .MoveFirst
    End With
    xlFillArray = RS.GetRows(iRows)
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function

---

Hi Graham,

Thanks so much for working on this. Sorry for seeming obtuse, I was trying to keep it as simple as possible to keep the options open.

Unfortunately I can't seem to get this to work. I try to run it against emails in my inbox and nothing appears to happen. Is there something particular about using Outlook Macros I should be aware of? I'm more familiar with using and modifying word and excel macros (and have used a lot of your work in the past).

The various conditions have to apply for anything to happen. The subject must be in the format

Employee ID - Position Change - 13/05/2019

i.e. three blocks of text (0,1 & 2) separated by hyphens. Any other message format is ignored. Employee ID must therefore not contain a hyphen, or you would have to adjust the numbers of elements in the variant produced from splitting.

Code:

---

If Not UBound(vSubject) = 2 Then GoTo lbl_Exit

---

The last of the three segments must be a date.

Code:

---

If Not IsDate(Trim(vSubject(2))) Then GoTo lbl_Exit

---

The worksheet must be in the format suggested i.e. the first column should have the list of IDs, the second the e-mail address(es) where the messages are to be sent. There should be a header row. You should however get an error message if the workbook is in error.

As you have probably gathered the worksheet is read into an array and that array is processed to get the IDs and addresses.

The macros should be saved in an ordinary module or the rule if used won't see it.

Outlook VBA can be very fussy over security. If the macro doesn't run at all see https://www.gmayor.com/create_and_em...gital_cert.htm

That works perfectly and is exactly what I was looking for. Thank you so much for your work on this.