Need VBA Mail Merge Help!

[timpak]

So this has been a published code - (do not know who the author is) - for mail merge.

For my case, I have an excel file with line items and an email column and a purchase number column. I am using Microsoft Word and its Mail Merge function to populate a pre-drafted e-mail to send out to all of the line items, to its respective e-mail with all of the Merge Fields.

The code below is supposed to enable a variable subject for the e-mail. I want a dynamic subject line to include the purchase number in the subject for each e-mail. For example, the purchase number column heading is labeled Purch_Doc. And I want my e-mail subject line to say "Invoice Inquiry for Purchase Number <Purch_Doc>", so that the purchase number is variable in the subject line.

Probably the most simplest, but my problem currently: where do I put that subject line in the code? There were no clear instructions or notes on where I should put what I want for the subject in the code.

Thanks in advance!

-Tim

Dim WithEvents wdapp As Application
Dim EMAIL_SUBJECT As String
Dim FIRST_RECORD As Boolean


Private Sub Document_Open()

    Set wdapp = Application
    ThisDocument.MailMerge.ShowWizard 1
   
End Sub

Private Sub Document_Close()

    Set wdapp = Nothing
    
End Sub


Private Sub wdapp_MailMergeBeforeRecordMerge(ByVal Doc As Document, Cancel As Boolean)
    Dim i As Integer
    
    With ActiveDocument.MailMerge
    
        If FIRST_RECORD = True Then 
            EMAIL_SUBJECT = .MailSubject
            FIRST_RECORD = False
        Else .MailSubject = EMAIL_SUBJECT
        End If

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

    End With
    
     
End Sub


Private Sub wdapp_MailMergeBeforeMerge(ByVal Doc As Document, ByVal StartRecord As Long, ByVal EndRecord As Long, Cancel As Boolean)

    FIRST_RECORD = True
    
End Sub

Private Sub wdapp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)

    ActiveDocument.MailMerge.MailSubject = EMAIL_SUBJECT
     
End Sub

 

[John_w]

The only code you need is:

Dim WithEvents wdapp As Application

Private Sub wdapp_MailMergeBeforeRecordMerge(ByVal Doc As Document, Cancel As Boolean)
    
    With ActiveDocument.MailMerge
        .MailSubject = "Invoice Inquiry for Purchase Number " & .DataSource.DataFields(2).Value
    End With
    
End Sub

where the 2 is the column number of the purchase number column in your Excel data source, i.e. column B in this example.

PS - put the code in the ThisDocument module.

 

[John_w]

Sorry, you also need this code to initialise and destroy the wdapp event object:

Private Sub Document_Open()
    Set wdapp = Application
End Sub


Private Sub Document_Close()
    Set wdapp = Nothing
End Sub