# VBForums UtilityBank > UtilityBank - Tutorials >  Mail merge in word for mailing labels with excel.

## Bulevardi

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
wrdDoc.Activate


' 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, _
                                 AutoFitBehavior:=wdAutoFitFixed)


' 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:


Range(Rng("Sheet1")).Select


' 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:
http://bulevardi.be/?content=scripting&example=exvb3

----------


## ahmedkhairy

thanks buddy  :Smilie:

----------


## nvb17

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

----------

