Excel Data Source File

The Excel 2013 Data File used is a list of Product Vendors from the AdventureWorks 2014 database. There are Names with split address lines 1 & 2 as well as separated City, State, and Postal Code fields.

Code the Word document Recordset and Connection

The sub created in the Module in VBA is named sPrintExcelTable. The beginning section has the declarations of all of our fields for ADODB connection and Recordsets - one to count the rows and the other to populate the data. Be sure to add a Reference to Microsoft ActiveX Data Objects 2.8 Library to the Project in Tools \ References to use the ADODB objects.

Sub sPrintExcelTable()
 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, rsCount As ADODB.Recordset
 Dim cn As ADODB.Connection
 Dim sqlGetTbl As String
 Dim sDataSource As String, sDataTable As String
 Dim sProvider As String

Set up the connections in code. Note the Connection String for an Excel 2013 Object is different than an MS Access object (previously used in other articles I wrote here).

 Set cn = New ADODB.Connection
 Set rs = New ADODB.Recordset
 Set rsCount = New ADODB.Recordset

 sDataSource = "C:\MS Access\ProductVendors.xlsx"
 sDataTable = "Sheet1"

 sDataSource = sDataSource & ";Extended Properties='Excel 12.0 Xml;HDR=Yes'"
 sDataTable = "[" & sDataTable & "$]"

 sProvider = "Microsoft.ACE.OLEDB.12.0;" 'Excel Data Source version 2007 or greater

 cn.Provider = sProvider
 cn.ConnectionString = "Data Source=" & sDataSource
 cn.Open

Selecting the Fields in the SQL string from Excel into Word

Set the recordsets. Note that AddressLine1 is concatenated with AddressLine2 and the City, StateProvinceName, and Postal Code are concatenated with some formatting.

 sqlGetTbl = "SELECT COUNT(*) FROM " & sDataTable
 rsCount.Open sqlGetTbl, cn, adOpenDynamic, adLockOptimistic

 sqlGetTbl = "SELECT BusinessEntityID, VendorName, AddressLine1 + ' ' + AddressLine2 as Addr1," & _
 " City + ', ' + StateProvinceName + ' ' + PostalCode as Addr2 FROM " & sDataTable
 rs.Open sqlGetTbl, cn, adOpenDynamic, adLockOptimistic

If you are write SQL code, you might wonder why there is no additional code to check AddressLine2 and make sure it is Not Null. It is not necessary to check for the Null Value in this instance of SQL used on Excel as you normally would in SSMS when querying a SQL database - the query rows for AddressLine1 + AddressLine2 would result in blank values for the rows with Null AddressLine2 as displayed in this sample below. There is no problem like this when querying the Excel Data Source.

Set up the beginning of the document in VBA. At the bottom of this code section, there is a comment indicating where the Page Number is added in VBA.

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)
 Selection.WholeStory
 Selection.Delete

 Selection.Font.Bold = True
 Selection.Font.Name = "Times New Roman"
 Selection.TypeText Text:="Product Vendors"

 Selection.TypeText Text:=Chr(11) & "Adventure Works"
 Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
 Selection.ParagraphFormat.LineUnitAfter = 1

 Selection.TypeParagraph
 Selection.Font.Name = "Times New Roman"
 Selection.Font.Size = "9"
 Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
 Selection.Font.Bold = False
'Adding the Page Number to the footer here
 Selection.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add _
   PageNumberAlignment:=wdAlignPageNumberCenter, FirstPage:=True

Set up the Table with Borders and format the column widths.

 t = 1

If Not rs.EOF Then
 ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=labelrows + 1, NumColumns:= _
  labelcolumns, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
  wdAutoFitFixed
 ActiveDocument.Tables(t).Columns.PreferredWidth = InchesToPoints(2)
 ActiveDocument.Tables(t).Columns(2).PreferredWidth = InchesToPoints(8)
 ActiveDocument.Tables(t).Columns(3).PreferredWidth = InchesToPoints(10)
 ActiveDocument.Tables(t).Columns(4).PreferredWidth = InchesToPoints(10)
 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
End If

Write code to iterate through the 104 rows or data in the Excel file and build the table.

i = 1
j = 1

If Not rs.EOF And Not IsNull(rs.Fields(1)) 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

    ActiveDocument.Tables(t).Cell(j + 1, k).Range.InsertBefore rs.Fields(k - 1)

    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
     ActiveDocument.Tables(t).Cell(j + 1, k).Range.InsertBefore rs.Fields(k - 1)
    End If
  End If

  Select Case k
   Case 3:
    ActiveDocument.Tables(t).Cell(j + 1, k).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
   Case 1, 2:
    ActiveDocument.Tables(t).Cell(j + 1, k).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
  End Select
 Next k
 rs.MoveNext
Next j
End If

Finally, add the code for the Header to appear on each page, instead of only the first page.

 ActiveDocument.Tables(t).Rows(1).Select
 Selection.Rows.HeadingFormat = True
 ActiveDocument.Save

If Not rs.EOF Then
 rsRows = ActiveDocument.Paragraphs.Count
 Selection.Move Unit:=wdParagraph, Count:=rsRows
 Selection.InsertBreak Type:=wdPageBreak
End If

 rs.Close
 cn.Close

End If
End Sub