Programming Samples

Click here to go to:



Excel VBA

Word VBA

MS Access

Python

T-SQL

SSIS

SSRS

Power BI

Crystal Reports

SSAS

SQL Replication

C# Code

ASP .NET Code

Oracle PL/SQL

Database Diagramming


Back to Home Page


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.

SQL to Create Stored Procedure from Query

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.

SQL code Creating Unique RowNumberID for each Vendor

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.

SQL Procedure Loop to return Output variable and the Recordsets for each ID

The execution of the Stored Procedure in SSMS delivers the following output in the Results window.

SQL Recordsets Returned by Stored Procedure

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.

SQL Server MS Word Vendor Letter 1

SQL Server MS Word Vendor Letter 2

SQL Server MS Word Vendor Letter 3