Edit subject of emails based on mail merge data source

[Eperluette]

Hello everyone,

I am using a great macro created by Doug Robbins that is available at word.mvps.org/faqs/mailmerge/mergewithattachments.htm

Using this macro, I can generate an electronic mail merge where each email is
a) personalised
b) includes an individual, personalised attachment

This is perfect but one thing the macro doesn't allow you to is to personalise the email subject. Ideally, I'd like to be able to insert a field when prompted to do so, in this format: <field> and add a bit of code that would replace <field> by the actual data source for each mail merge when performing the mail merge.

Doug Robbins' macro is here below:

Sub emailmergewithattachments()Dim Source As Document, Maillist As Document, TempDoc As Document
Dim Datarange As Range
Dim i As Long, j As Long
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim mysubject As String, message As String, title As StringSet Source = ActiveDocument' Check if Outlook is running.  If it is not, start Outlook
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
    Set oOutlookApp = CreateObject("Outlook.Application")
    bStarted = True
End If' Open the catalog mailmerge document
With Dialogs(wdDialogFileOpen)
    .Show
End With
Set Maillist = ActiveDocument' Show an input box asking the user for the subject to be inserted into the email messages
message = "Enter the subject to be used for each email message."    ' Set prompt.
title = " Email Subject Input"    ' Set title.
' Display message, title
mysubject = InputBox(message, title)' Iterate through the Sections of the Source document and the rows of the catalog mailmerge document,
' extracting the information to be included in each email.
For j = 1 To Source.Sections.Count - 1
    Set oItem = oOutlookApp.CreateItem(olMailItem)
    With oItem
        .Subject = mysubject
        .Body = Source.Sections(j).Range.Text
        Set Datarange = Maillist.Tables(1).Cell(j, 1).Range
        Datarange.End = Datarange.End - 1
        .To = Datarange
        For i = 2 To Maillist.Tables(1).Columns.Count
            Set Datarange = Maillist.Tables(1).Cell(j, i).Range
            Datarange.End = Datarange.End - 1
            .Attachments.Add Trim(Datarange.Text), olByValue, 1
        Next i
        .Send
    End With
    Set oItem = Nothing
Next j
Maillist.Close wdDoNotSaveChanges'  Close Outlook if it was started by this macro.
If bStarted Then
    oOutlookApp.Quit
End IfMsgBox Source.Sections.Count - 1 & " messages have been sent."'Clean up
Set oOutlookApp = NothingEnd Sub

I wonder whether I could add something like this:

        i = .DataSource.DataFields.Count
        
        Do While i > 0
            '.MailSubject = Replace(.MailSubject, "<" & .DataSource.DataFields(i).Name & ">", .DataSource.DataFields(i).Value, , , vbTextCompare)
            'i = i - 1
        Loop

Unfortunately this is far too advanced for me and I am not sure how to integrate this to the existing macro to make it work. I would be grateful if I could be pointed in the right direction or for any help or advice.

Thank you so much,

Sarah

[gmayor]

I have a similarly conceived add-in to that produced by Doug: http://www.gmayor.com/ManyToOne.htm. This one does allow the use of a field to provide the subject. From your description you would use one to one mode.

Doug will no doubt be along soon to discuss what is possible with his version.