Automate Word Mail Merge For Address Labels

[Swi]

Could someone point me in the right direction on how to to a label mail merge using Word automation for address lables? Here is what I have so far. I am having issues with how to generate multiple labels on one sheet. Thanks.

            Dim oApp As New Word.Application
            Dim oMainDoc As Word.Document
            Dim oSel As Word.Selection
            Dim sDBPath As String
            
            'Start a new main document for the mail merge.
            Set oMainDoc = oApp.Documents.Add
            With oMainDoc.MailMerge
                .MainDocumentType = wdMailingLabels
                sDBPath = App.Path & "\Address Book.mdb"
               .OpenDataSource Name:=sDBPath, _
                   SQLStatement:="SELECT * FROM [Master]"
                'Add the field codes to the document to create the form letter.
                With .Fields
                    Set oSel = oApp.Selection
                    .Add oSel.Range, "Name"
                    oSel.TypeParagraph
                    .Add oSel.Range, "Address"
                    oSel.TypeParagraph
                    .Add oSel.Range, "City"
                    oSel.TypeText ", "
                    .Add oSel.Range, "State"
                    oSel.TypeText " "
                    .Add oSel.Range, "Zip"
                End With
            End With
            'Perform the mail merge to a new document.
            With oMainDoc
                .MailMerge.Destination = wdSendToNewDocument
                .MailMerge.Execute Pause:=True
            End With
            oMainDoc.Close
            oApp.Quit
            Set oMainDoc = Nothing
            Set oApp = Nothing

Swi

 

[RonRepp]

Have you tried recording a macro in Word?

Also, what version of Word? It does make a difference.

Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors

http://www.repproductions.net

 

[Swi]

Yes, but it did not provide me with what I wanted. I just created a template in word and basically just used word automation to open the template and populate it via an SQL statement.

I am using Word 2000.

My next issue is that I am building an SQL statement dynamically based on user selection and it is saying that my SQL statement exceeeds a 255 byte limit.

Swi

 

[SkipVought]

What you have stated so far is native MS Word functionality in MailMerge.

If you select Labels, AND the appropriate label vendor/style, this feature places the {NextRecord} token on each label. You place the fields you want on the label template and that get propogated to all the labels, along with the token as previously described.

What do you actually need VB Code for? Changing the Connection property, maybe?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Swi]

This is an address book app for my wife and she wanted the capability to print to her template in Word and I have it working fine but when multiple records are selected and the SQL statement exceeds 255 characters it does not work.

            If lstNamesToPull.ListCount = 0 Then
                MsgBox "You must select a name from the Available Names Listbox!", vbCritical + vbOKOnly
                lstNames.SetFocus
                Exit Sub
            End If
            NamesToPull = ""
            For i = 0 To lstNamesToPull.ListCount - 1
                NamesToPull = NamesToPull & "[Name] = '" & lstNamesToPull.List(i) & "' OR "
            Next
            NamesToPull = Left$(NamesToPull, (Len(NamesToPull) - 4))
            oApp.DisplayAlerts = wdAlertsNone
            oApp.Visible = False
            oApp.Documents.Open App.Path & "\Occasion Mailing Labels.doc"
            With oApp.ActiveDocument.MailMerge
                .MainDocumentType = wdMailingLabels
                sDBPath = App.Path & "\Address Book.mdb"
                .OpenDataSource Name:=sDBPath, _
                SQLStatement:="SELECT * FROM [Master] WHERE " & NamesToPull
                .Destination = wdSendToNewDocument
                .SuppressBlankLines = True
                .Execute Pause:=True
            End With
                oApp.ActiveDocument.SaveAs FileName:="C:\Documents and Settings\Owner\Desktop\Multiple Labels.doc", _
                FileFormat:=wdFormatDocument, LockComments:=False, Password:="", _
                AddToRecentFiles:=False, WritePassword:="", ReadOnlyRecommended:=False, _
                EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
                :=False, SaveAsAOCELetter:=False
            oApp.ActiveDocument.Close wdDoNotSaveChanges
            oApp.Quit wdDoNotSaveChanges
            Set oApp = Nothing
            NamesToPull = ""
            For i = 0 To lstNamesToPull.ListCount - 1
                NamesToPull = NamesToPull & vbCrLf & lstNamesToPull.List(i) & " and"
            Next
            NamesToPull = Left$(NamesToPull, (Len(NamesToPull) - 4))
            MsgBox "Please check the desktop for labels generated for:" & NamesToPull & "!", vbInformation + vbOKOnly

Swi