Sub TestTableLabels()
'
' TestTableLabels Macro
' Macro recorded 7/30/2005 by User
'Create Word table from dataset so header rows can be inserted
Dim DataTable As Table
Dim FirstRow As Row
Dim CurCell As Cell
Dim i As Integer
Dim Doc1 As Document
Dim Doc2 As Document
Set Doc1 = ActiveDocument
ActiveDocument.Select
With Selection
.Collapse Direction:=wdCollapseEnd
.Range.InsertDatabase _
Format:=wdTableFormatSimple2, Style:=191, _
LinkToSource:=False, Connection:="Entire Spreadsheet", _
DataSource:="C:\Me\Reference\Work\labels.csv"
End With
Set DataTable = ActiveDocument.Tables(1)
Set FirstRow = DataTable.Rows.Add(BeforeRow:=DataTable.Rows(1))
For Each CurCell In FirstRow.Cells
CurCell.Range.InsertAfter Text:="Cell " & i
i = i + 1
Next CurCell
ActiveDocument.SaveAs FileName:="C:\Me\Reference\Work\LabelTable.doc", _
FileFormat:=wdFormatDocument
'ActiveDocument.Close
'Create the mailmerge
Application.MailingLabel.DefaultPrintBarCode = False
Application.MailingLabel.CreateNewDocument Name:="5161"
ActiveDocument.MailMerge.MainDocumentType = wdMailingLabels
ActiveDocument.MailMerge.OpenDataSource Name:= _
"C:\Me\Reference\Work\LabelTable.doc", ConfirmConversions:=False, _
ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:="", SQLStatement:="", SQLStatement1:="", SubType:= _
wdMergeSubTypeOther
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:="""Cell_0"""
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:="""Cell_1"""
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:="""Cell_2"""
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:="""Cell_3"""
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:="""Cell_4"""
Selection.MoveLeft Unit:=wdCharacter, Count:=5, Extend:=wdExtend
Selection.Font.Size = 11
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=8
Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(3.76), _
Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
Selection.ParagraphFormat.TabStops(InchesToPoints(3.76)).Position = _
InchesToPoints(3.88)
Selection.TypeText Text:=vbTab
Selection.MoveRight Unit:=wdCharacter, Count:=8
Selection.TypeParagraph
Selection.TypeParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Bold = wdToggle
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.TypeParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.MoveRight Unit:=wdCharacter, Count:=8
Selection.TypeText Text:=vbTab
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Size = 9
Selection.MoveRight Unit:=wdCharacter, Count:=1
WordBasic.MailMergePropagateLabel
Set Doc2 = ActiveDocument
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
Doc1.Close
Doc2.Close (wdDoNotSaveChanges)
End Sub