Insertdatabase Does Not Work with Just 1 Record

[silvrwood]

I created a macro that propagates labels from a .csv file. I used this technique because the report could generate anywhere from 1 - 3000 labels, and just creating a mail merge doc that is linked to the dataset was only generating the same amount of labels as used in the original dataset. The dataset also has no header row, so I had to bring it into a table so that I could insert a header row for mail merge fields.

However, it turns out that Word cannot open the database when there is only one record.

Any suggestions on a work around for this eventuality?

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

[silvrwood]

I found that using InsertFile followed by ConvertToTable allows the labels to be propagated with just one record. However, it does not propagate the correct # of labels, just one page. Any ideas on why, or how to combine the 2 to make it work for any # of records?

Sub Labels()
 
 
Dim DataTable As Table
Dim FirstRow As Row
Dim CurCell As Cell
Dim i As Integer
 
Dim Doc1 As Document
Dim Doc2 As Document
 
Dim oRngBkmk As Range
Dim oRng As Range
 
 
Set Doc1 = ActiveDocument
 
ActiveDocument.Select
 
''' set a range for the start of the insertion
Set oRng = Selection.Range
 
With oRng
''' insert the .csv file
.InsertFile FileName:="O:\Prolaw\labels.csv", ConfirmConversions:=False
''' convert the .csv file insertion to a table
.ConvertToTable Separator:=",", NumColumns:=5, Format:=wdTableFormatSimple2, AutoFitBehavior:=wdAutoFitContent
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:="O:\ProLaw\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:= _
        "O:\ProLaw\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