MS Word Mail Merge Letter with Tables using SQL Server
MS Word Mail Merge Letter using a SQL Server Command Object and Connection
This article is similar to the "MS Word Mail Merge Letter with Data List in Table" article on this site - it uses MS Word VBA to code a Mail Merge, but this time it is connecting to a SQL Server Data Source which has some distinct code differences from the connection to an MS Access or Excel Data Source. The code formatting the Address above the body of a letter followed by a table of varying numbers of rows of Purchase Order information is still similar however the Recordsets will be called automatically 1 at a time in a For Loop as they are being delivered from a Stored Procedure - all T-SQL code is also shown. The data set used here is 80 Vendors with varying rows of AdventureWorks Purchase Order information. Each letter contains the Purchase Orders located at the bottom of the page by utilizing 2 For Loops for each of the ADODB Recordsets returned by the Command object.
Creating the SQL Server Stored Procedure
Code a stored procedure in SQL Server SSMS to use the query on the tables from the AdventureWorks2014 database. The stored procedure includes 1 output variable, @x which will tell the VBA code how many recordsets to expect to use in a For loop. The Select statement pushes the Vendor & Purchase Order information into a Temp Table so that an sequential Vendor ID may be added.
The next part of the Stored Procedure takes only the Vendor IDs and assigns the Row_Number of 1 through 80 to each unique Vendor ID in another Temp table. The main Temp table, #tmpVendor, is then updated with the sequential ID - the same type of ID manually added in the Excel version of this article.
The final T-SQL code retrieves the count of vendors which is then provided to the OUTPUT variable @x in the Set statement. Variable @i is set to 1 for a While loop which will deliver the rows for each tID for each Vendor to the VBA code in Word.
The execution of the Stored Procedure in SSMS delivers the following output in the Results window.
Creating the Merge VBA Code in MS Word
Create a new Module to write the Code to connect to the SQL Server database Stored Procedure. The ADODB connection, recordset, and a new ADODB Command are added as well as 2 additional integers x and y. Coding the Connection string is very simple with 1 line of code and then it is opened.
Sub sPrintSQLTable()
Dim labelrows, labelcolumns, i As Integer
Dim j As Integer, k As Integer, t As Integer
Dim rsRows As Integer
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim cmd As ADODB.Command
Dim x As Integer, y As Integer
'set up the connection and Recordset as New
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
'one code line to set the SQL connection string and open
cn.ConnectionString = "Provider=MSDataShape;Data Provider=SQLOLEDB;SERVER=<YourDatabaseName>;DATABASE=AdventureWorks2014;Integrated Security=SSPI"
cn.Open
The ADODB Command is set and followed by the properties to indicate it is a Stored Procedure (not a SQL Select Statement), the Active Connection, and the Output Parameter @x. By setting the ADODB Recordset to receive Command.Execute code, rs receives all of the Datasets in it and they may be retrieved by using a For Loop in the next section.
'set the ADODB command object with Type, Stored Proc Name,
'Connection, and the OUTPUT parameter of @x to get the dataset count
Set cmd = New ADODB.Command
With cmd
.CommandType = adCmdStoredProc
.CommandText = "VendorPurchaseOrderData"
.CommandTimeout = 300
.ActiveConnection = cn 'Connection object
.Parameters.Refresh
Set rs = .Execute
x = .Parameters("@x")
End With
Some code is added to allow rs to run through some T-SQL items that did not contain any data (such as the Temp Table creation and updates) until it reaches the 1st Recordset that contains the Vendor data. The For Loop begins with 1 and executes through x (80) recordsets. The code which tests for y greater than 1 will force rs to move to the Recordset. The labelrows may be obtained by the rs.RecordCount.
'move past operations to generate temp tables and set up while loop in stored proc
Do Until (rs.State = adStateOpen)
Set rs = rs.NextRecordset
Loop
'start the For loop to iterate through all datasets
For y = 1 To (x)
'if y is not the 1st recordset, move to the next one
If (y > 1) Then
Set rs = rs.NextRecordset
End If
'get the record count of the RS
labelrows = rs.RecordCount
labelcolumns = 5
The code below is similar to the previous article using an Excel Data Source to build the letter and the Tables.
If Len(labelcolumns) > 0 And Len(labelrows) > 0 Then
ActiveDocument.PageSetup.HeaderDistance = InchesToPoints(0.5)
ActiveDocument.PageSetup.FooterDistance = InchesToPoints(0.5)
ActiveDocument.PageSetup.LeftMargin = InchesToPoints(0.75)
ActiveDocument.PageSetup.RightMargin = InchesToPoints(0.75)
If y = 1 Then
Selection.WholeStory
Selection.Delete
End If
Selection.TypeParagraph
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = "9"
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.Font.Bold = False
Selection.TypeText Text:="August 14, 2017" & Chr(11)
t = (y * 2) - 1
The VBA Code to build the table no longer requires the test of rs.EOF and then the code similarly builds the Address block at the top and fills it with Lorem Ipsum text. The code then generates the 2 table with variable rows based on the count of rows for each recordset.
'Note: the If Not rs.EOF statement is not present
'it is no longer needed to test the recordset as we are getting one Address with each rs
'table 1 with address
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=6, NumColumns:=1, _
DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
ActiveDocument.Tables(t).Columns.PreferredWidth = InchesToPoints(8)
ActiveDocument.Tables(t).Rows.Height = InchesToPoints(0.2)
ActiveDocument.Tables(t).Borders(wdBorderLeft).Visible = False
ActiveDocument.Tables(t).Borders(wdBorderRight).Visible = False
ActiveDocument.Tables(t).Borders(wdBorderTop).Visible = False
ActiveDocument.Tables(t).Borders(wdBorderBottom).Visible = False
ActiveDocument.Tables(t).Borders(wdBorderHorizontal).Visible = False
ActiveDocument.Tables(t).Borders(wdBorderVertical).Visible = False
'1st table
For k = 5 To 7
If Len(rs.Fields(k)) > 0 Then
ActiveDocument.Tables(t).Cell(k - 4, 1).Range.InsertBefore rs.Fields(k)
End If
Next k
'text for the letter
Selection.MoveDown Unit:=wdLine, Count:=10
Selection.TypeParagraph
Selection.TypeText Text:="Dear Vendor: " & Chr(11) & Chr(11)
Selection.TypeText Text:="Lorem ipsum dolor sit amet, consectetur adipiscing elit. Suspendisse auctor dapibus augue, nec viverra risus pretium nec. Nullam ac porta lorem, ut fermentum elit. Nullam sagittis eros ac risus lacinia scelerisque sed sed nulla. Ut sed nisl in ex volutpat lobortis. Pellentesque et turpis sit amet mauris aliquam rhoncus. In et commodo dui, eget pulvinar nibh. Donec iaculis ipsum lorem, a ullamcorper augue condimentum sit amet. Duis varius tellus id lorem convallis scelerisque." & Chr(11) & Chr(11)
Selection.TypeText Text:="Praesent ac diam sit amet ex fermentum aliquet. Praesent ut lectus feugiat, placerat ipsum sollicitudin, mattis enim. Phasellus scelerisque tortor risus, nec scelerisque lacus faucibus vel. Nam eu auctor magna, eget mattis purus. Nulla suscipit urna nec purus pellentesque maximus. Nam mauris eros, dignissim at maximus eget, ornare ut enim. Curabitur magna orci, varius in urna ac, tempor mattis ipsum. Nulla eget accumsan lectus. Lorem ipsum dolor sit amet, consectetur adipiscing elit. Mauris iaculis varius aliquet. Quisque at nulla viverra, gravida nisl eget, elementum ligula. Fusce nibh enim, venenatis nec interdum eget, gravida in libero. Duis sollicitudin lectus eu feugiat tincidunt. Donec sed sapien a ante tempus lobortis. Vestibulum eleifend ante neque, non consectetur leo dictum ut." & Chr(11)
t = t + 1 '2nd table
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=labelrows + 1, NumColumns:= _
labelcolumns, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
ActiveDocument.Tables(t).Columns.PreferredWidth = InchesToPoints(8)
ActiveDocument.Tables(t).Rows.Height = InchesToPoints(0.3)
ActiveDocument.Tables(t).Borders(wdBorderLeft).Visible = True
ActiveDocument.Tables(t).Borders(wdBorderRight).Visible = True
ActiveDocument.Tables(t).Borders(wdBorderTop).Visible = True
ActiveDocument.Tables(t).Borders(wdBorderBottom).Visible = True
ActiveDocument.Tables(t).Borders(wdBorderHorizontal).Visible = True
ActiveDocument.Tables(t).Borders(wdBorderVertical).Visible = True
i = 1
j = 1
rs.MoveFirst
'iterate through the number of rows in the recordset
If Not rs.EOF Then
For j = 1 To labelrows
For k = 1 To labelcolumns
If j = 1 Then
ActiveDocument.Tables(t).Cell(j, k).Range.InsertBefore rs.Fields(k - 1).Name
ActiveDocument.Tables(t).Cell(j, k).Range.Shading.BackgroundPatternColor = wdColorGray15
ActiveDocument.Tables(t).Cell(j, k).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
If Len(rs.Fields(k - 1)) > 0 Then
If k = 3 Or k = 4 Or k = 5 Then
ActiveDocument.Tables(t).Cell(j + 1, k).Range.InsertBefore Format(rs.Fields(k - 1), "$###,#00.00")
Else
ActiveDocument.Tables(t).Cell(j + 1, k).Range.InsertBefore rs.Fields(k - 1)
End If
End If
Selection.EndOf Unit:=wdParagraph, Extend:=wdExtend
Selection.Range.Font.Bold = True
Selection.Range.Font.Underline = wdUnderlineSingle
Else
If Len(Trim(rs.Fields(k - 1))) > 0 Then
If k = 3 Or k = 4 Or k = 5 Then
ActiveDocument.Tables(t).Cell(j + 1, k).Range.InsertBefore Format(rs.Fields(k - 1), "$###,#00.00")
Else
ActiveDocument.Tables(t).Cell(j + 1, k).Range.InsertBefore rs.Fields(k - 1)
End If
End If
End If
Select Case k
Case 3, 4, 5:
ActiveDocument.Tables(t).Cell(j + 1, k).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
Case 1, 2:
ActiveDocument.Tables(t).Cell(j + 1, k).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Select
Next k
rs.MoveNext
Next j
rsRows = ActiveDocument.Paragraphs.Count
Selection.Move Unit:=wdParagraph, Count:=rsRows
Selection.InsertBreak Type:=wdPageBreak
End If
End If
Next y
The code goes to the next y and iterates until it reaches 80. Then the Recordset and Connection are closed.
rs.Close
cn.Close
End Sub
Generate the merged letters by running the VBA code in MS Word.
