Mail Merge to Labels Not Resizing # of Labels to # of Records

[silvrwood]

I created a mail merge doc for which the data set is a .csv file & the records pull into labels. However, it only keeps the same # of labels as for the original dataset, so datasets with fewer records have too many labels and datasets with more records don't pull all the records in.

Do I need replan this so that a macro is run to create a new mail merge, or is there some way to set this that I am missing. If I do need to write a macro to create the mail merge, could someone start me out? I'm not sure where to begin to create a mail merge.

[silvrwood]

I have this thus far:


But now at the tail end it tells me that the field codes are not valid for the data set: "This merge field is in use in the main document but does not exist in the data source." Does this have anything to do with the fact that there is no header in the data source & that it uses comma delimiters? I don't see a way to set that in the VBA code.

Application.MailingLabel.DefaultPrintBarCode = False
    Application.MailingLabel.CreateNewDocument Name:="5161"
    
    ActiveDocument.MailMerge.MainDocumentType = wdMailingLabels
    ActiveDocument.MailMerge.OpenDataSource Name:="O:\ProLaw\label.csv", _
        ConfirmConversions:=True, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=O:\ProLaw;Mode=Read;Extended Properties=""HDR=NO;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=96;Jet OLEDB:Database Loc" _
        , SQLStatement:="SELECT * FROM `label#csv`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeOLEDBText
    ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
        , Text:="""F1"""
    ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
        , Text:="""F2"""
    ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
        , Text:="""F3"""
    ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
        , Text:="""F4"""
    ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
        , Text:="""F5"""
    Selection.MoveLeft Unit:=wdCharacter, Count:=5, Extend:=wdExtend
    Selection.Font.Name = "Arial"
    Selection.Font.Size = 11
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=4
    Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(3.73), _
        Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
    Selection.ParagraphFormat.TabStops(InchesToPoints(3.73)).Position = _
        InchesToPoints(3.88)
    Selection.TypeText Text:=vbTab
    Selection.MoveRight Unit:=wdCharacter, Count:=4
    Selection.TypeParagraph
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Bold = wdToggle
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeParagraph
    Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=2
    Selection.TypeParagraph
    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.MoveLeft Unit:=wdCharacter, Count:=4
    Selection.TypeText Text:=vbTab
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Size = 9
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    WordBasic.MailMergePropagateLabel
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
End Sub

But now at the tail end it tells me that the field codes are not valid for the data set: "This merge field is in use in the main document but does not exist in the data source." Does this have anything to do with the fact that there is no header in the data source & that it uses comma delimiters? I don't see a way to set that in the VBA code.

[silvrwood]

OK. I worked this one out by inserting the data into a Word table, adding a row, inserting text into each cell of that row to act as headers, and then using that table for my datasource.

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