Results 1 to 3 of 3
  1. #1

    Thread Starter
    Junior Member
    Join Date
    Oct 2010

    Mail merge in word for mailing labels with excel.

    If you want to make mailing labels with data from an Excel table, so you can mail merge this in Word, you can do it automatically with a simple VBA script.
    Requirements: Excel and Word 2010, awareness of your VBA editor.

    Note: tested in Office version 2010. Not sure if it will work in Office 2007 or older versions.

    Sub create_labels()
    Dim strThisWorkbook As String
    strThisWorkbook = ThisWorkbook.FullName
    ' create the word document:
    Dim oWORD As Word.Application, wrdDoc As Word.Document, wrdTable As Word.Table
    Set oWORD = New Word.Application
    Set wrdDoc = oWORD.Documents.Add
    ' so we can see what is happening in word:
    oWORD.Visible = True
    ' adjusting the page setup properties first:
        With wrdDoc.PageSetup
            .Orientation = wdOrientPortrait
            .TopMargin = CentimetersToPoints(1.59)
            .BottomMargin = CentimetersToPoints(0)
            .LeftMargin = CentimetersToPoints(0.47)
            .RightMargin = CentimetersToPoints(0.47)
            .Gutter = CentimetersToPoints(0)
            .HeaderDistance = CentimetersToPoints(1.25)
            .FooterDistance = CentimetersToPoints(1.25)
            .PageWidth = CentimetersToPoints(21)
            .PageHeight = CentimetersToPoints(29.7)
        End With
    ' creating the table of labels (in this example, 2 columns, 7 rows):
    Set wrdRange = wrdDoc.Range
    Set wrdTable = wrdDoc.Tables.Add(Range:=wrdRange, NumRows:=7, NumColumns:=2, _
                                     DefaultTableBehavior:=wdWord9TableBehavior, _
    ' adjusting the table properties:
    With wrdTable
            .Columns.PreferredWidth = CentimetersToPoints(9.9)
            .TopPadding = CentimetersToPoints(0)
            .BottomPadding = CentimetersToPoints(0)
            .LeftPadding = CentimetersToPoints(0.3)
            .RightPadding = CentimetersToPoints(0.3)
            .Rows.HeightRule = wdRowHeightExactly
            .Rows.Height = CentimetersToPoints(3.81)
            .Rows.Alignment = wdAlignRowCenter
            .Spacing = 0
            .AllowPageBreaks = True
            .AllowAutoFit = True
            .AutoFitBehavior (wdAutoFitFixed)
            .AutoFitBehavior (wdAutoFitFixed)
            .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
            .Borders(wdBorderRight).LineStyle = wdLineStyleNone
            .Borders(wdBorderTop).LineStyle = wdLineStyleNone
            .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
            .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
            .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
            .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
            .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
            .Borders.Shadow = False
         End With
    ' getting the range of data from out excel data tabel:
    ' finally, processing the data into our labels with a mail merge:
    With oWORD.MailingLabel.Application.ActiveDocument
     .mailmerge.MainDocumentType = wdMailingLabels
    ' choosing the right document and data table:
     .mailmerge.OpenDataSource ThisWorkbook.FullName, ConfirmConversions = "False", ReadOnly = "False", _
                               LinkToSource = "True", AddToRecentFiles = "False", , , , , , , _
                               "Data Source=" & strThisWorkbook & ";Mode=Read", _
                               "SELECT * FROM `Sheet1$`"
     .mailmerge.DataSource.ActiveRecord = wdFirstRecord
    ' iterate through each label:
    ' for each row (in excel):
        For r = 4 To .mailmerge.DataSource.RecordCount
    ' for each field (in excel):
            For f = .mailmerge.DataSource.DataFields.Count To 1 Step -1
              .Application.Selection = .mailmerge.DataSource.DataFields.Item(f).Value & vbCrLf
            Next f
    ' go to the next row (in excel):
          .mailmerge.DataSource.ActiveRecord = (r + 1)
    ' go to the next label (in word):
          .Application.Selection.MoveRight Unit:=wdCell
        Next r
    ' to be sure your data is visible:
     .mailmerge.ViewMailMergeFieldCodes = wdToggle
    End With
    ' no closures for your word object needed as you close your word app later on yourself.
    End Sub
    Function Rng(Optional WorksheetName As String)
    ' the RNG range makes the range from A6 to C lastrow
        Dim LastRow As Integer
        Dim lastcol As String
        lastcol = "C"
            If WorksheetName = vbNullString Then
               WorksheetName = ActiveSheet.Name
            End If
        With Worksheets(WorksheetName)
            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
           End With
            Rng = "A6:" & lastcol & LastRow
    End Function
    More explanation and a working example as live demo to download right here:

  2. #2
    Join Date
    Jul 2012

    Re: Mail merge in word for mailing labels with excel.

    thanks buddy

  3. #3
    Registered User
    Join Date
    Jun 2013

    Re: Mail merge in word for mailing labels with excel.

    Hi, I am trying to mail merge excel data with 207 rows and 7 columns with the same code in Microsoft 2010.I get an 'Incorrect Error User-defined type' error.Can someone please help me with the code. Thanks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts


Click Here to Expand Forum to Full Width

We have made updates to our Privacy Policy to reflect the implementation of the General Data Protection Regulation.