Help writing VBA Code to run a macro after Mailmerge

[BnashGran]

Hello,
I am running Windows 8.1 and Office 2013. I am using mail merge to create product spec sheets which I will convert to PDF. Each sheet contains main fields in tables and in text. Some of the spec sheets will have blank fields due to the nature of the products. Thus I am writing a macro to delete empty rows and tables in the spec sheets. This portion of the macro works perfectly. However, I would like to set the macro to prompt the user to run whenever a mail merge is complete. This way, users who are making these spec sheets in the future don't forget to run the macro. I have created a new word template to house the macros and each spec sheet mail merge form references this template. I have read online that I need to create an application variable and then link that to a sub using the Application_Mailmergeafterrecordmerge Event. However. I do not know how to write the application. Most of my knowledge on this comes from http :// msdn.microsoft. com/ en-us /library /ff198157 (v=office.15). aspx. If someone could provide help declaring an application variable, I would be very appreciative. I have attached the code that I have thus far for my macro. Lastly, I apologize if I have broken any of the forum rules.


Public Sub Application_MailMergeAfterRecordMerge(Document)


If MsgBox("Do you want to clean this specsheet?", vbYesNo, "Clean Document") = vbYes Then
Call DeleteEmptyRows


Else
Exit Sub


End If


End Sub
Public Sub DeleteEmptyRows()


Dim oTable As Table, oRow As Range, oCell As Cell, Counter As Long, _
NumRows As Long, TextInRow As Boolean




For Each oTable In ActiveDocument.Tables


Set oRow = oTable.Rows(1).Range
NumRows = oTable.Rows.Count
Application.ScreenUpdating = False


For Counter = 1 To NumRows


StatusBar = "Row " & Counter
TextInRow = False


For Each oCell In oRow.Rows(1).Cells
If Len(oCell.Range.Text) > 2 Then

TextInRow = True
Exit For
End If
Next oCell


If TextInRow Then
Set oRow = oRow.Next(wdRow)
Else
oRow.Rows(1).Delete
End If


Next Counter


Next oTable


Application.ScreenUpdating = True
Call DeleteTable


End Sub
Public Sub DeleteTable()


Dim oTable As Table
For Each oTable In ActiveDocument.Tables


If oTable.Rows.Count <= 2 Then
oTable.Delete
End If


Next oTable


End Sub

[macropod]

Instead of running a macro after a merge has completed, I'd be inclined to drive the whole process via a macro. For example, the following macro will output each product to a separate file, each named according the contents of an assumed 'Product_Name' field in the data, with the tables cleaned up. The simple expedient of moving the 'Next i' line up to before the 'With ActiveDocument' line would result in only a single file being generated, in which case, you'd also probably want to omit all the lines using the 'StrName' variable and the '.Close SaveChanges:=False' line.

Sub Merge_To_Individual_Files()
'Merges one record at a time to the folder containing the mailmerge main document.
Application.ScreenUpdating = False
Dim StrFolder As String, StrName As String, MainDoc As Document
Dim i As Long, j As Long, j As Long
Set MainDoc = ActiveDocument
With MainDoc
StrFolder = .Path & Application.PathSeparator
For i = 1 To .MailMerge.DataSource.RecordCount
With .MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
If Trim(.DataFields("Product_Name")) = "" Then Exit For
StrName = .DataFields("Product_Name")
End With
.Execute Pause:=False
End With
With ActiveDocument
'Clean up the tables
For j = .Tables.Count To 1 Step -1
With .Tables(j)
'Delete empty rows
For k = .Rows.Count To 2 Step -1
With .Rows(k)
If Len(.Range.Text) = (.Cells.Count + 1) * 2 Then .Delete
End With
Next
'Delete 1-row tables
If .Rows.Count = 1 Then .Delete
End With
Next
.SaveAs2 FileName:=StrPath & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
' and/or:
.SaveAs2 FileName:=StrPath & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
Next i
End With
Application.ScreenUpdating = True
End Sub

[BnashGran]

Macropod
This code looks great and I think I will be able to adapt it to do what I need to do. Is there a way to change the i=1 code slightly so that I can pick which record I want to merge and how many I want to do? Thanks for the help.

[macropod]

For that you could use something like:

Sub Merge_To_Individual_Files()
'Merges one record at a time to the folder containing the mailmerge main document.
Application.ScreenUpdating = False
Dim StrFolder As String, StrName As String, MainDoc As Document
Dim i As Long, j As Long, x As Long, y As Long
x = InputBox("What is the first record to merge?")
y = InputBox("What is the last record to merge?")
If x = 0 Or y = 0 Or y < x Then Exit Sub
Set MainDoc = ActiveDocument
With MainDoc
If y > .MailMerge.DataSource.RecordCount Then
y = .MailMerge.DataSource.RecordCount
End If
StrFolder = .Path & Application.PathSeparator
For i = x To y
With .MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
If Trim(.DataFields("Product_Name")) = "" Then Exit For
StrName = .DataFields("Product_Name")
End With
.Execute Pause:=False
End With
With ActiveDocument
'Clean up the tables
For j = .Tables.Count To 1 Step -1
With .Tables(j)
'Delete empty rows
For k = .Rows.Count To 2 Step -1
With .Rows(k)
If Len(.Range.Text) = (.Cells.Count + 1) * 2 Then .Delete
End With
Next
'Delete 1-row tables
If .Rows.Count = 1 Then .Delete
End With
Next
.SaveAs2 FileName:=StrPath & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
' and/or:
.SaveAs2 FileName:=StrPath & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
Next i
End With
Application.ScreenUpdating = True
End Sub

[BnashGran]

Great! With this, I should be able to adapt everything to make it work. Thanks a ton for the help.