Excel First

Excel Solutions

Use Excel to Create Mass Letters

Summary:

This article describes how to create mass letters from Excel, using a Microsoft Word Document as the letter template and a Map between Excel Defined Names and Word Document Bookmarks.

Thoughts…

Starting from the example described in this article, there are numerous things that can be done: if we setup the same bookmarks in Multiple Word Documents, and if we use a multi-select dialog box to open and fill all those selected documents, we can create A SET of different documents for each recipient! Of course, all letters can be attached to an email and sent to that recipient email.

Most of the times,

It should be obvious you first need to create an Excel Table containing the name, physical address, email address, and other pertinent information that is to be inserted into the letter/email of all your intended recipients.

To create a letter for all recipients from your table, a Mail Merge will be all you need. But there are many scenarios where you need flexibility:

  •  you may want to create a letter for only 1 recipient, without going through all Mail Merge steps;
  • or you need to select a range of rows and create letters for all selected rows,
  • or, you may want to filter the table for different criteria, and create letters just for visible rows,
  • Create Letter for each row in table.

The following will cover all these scenarios, the letters will be saved as PDF files.

The key of this solution is a Map between Excel Defined Names and Word Document Bookmarks.

You can download the sample files from here:

Download: Create Individual or Mass Letters.xlsm
Download: Sample Letter.docx

How to Set Up the Map Between Excel Defined Names and Word Bookmarks:

Map Defined Names to Bookmarks
Map Defined Names to Bookmarks

In Map Table, each cell from column B has a defined name, listed in column A. The code will look in the list of defined names from column A, and will try to find a bookmark with the same name in the Word Document you indicated.

Add a bookmark for each duplicate field, but make sure that the bookmark name is present in all duplicates: use duplicate bookmark names like this: RecipientName , RecipientName1, RecipientName2, or even RecipientNamea, RecipientNameb and so on; the code will look for the main part: RecipientName and will send data to any bookmark that has a name starting with this, you can add any suffix you want. Create Duplicate bookmarks for any fields you need.

And the most important thing: make sure that the bookmarks are visible, this way you will be able to see those square brackets that identifies a bookmark, to avoid deleting them when editing the document… From Word Options, Advanced Tab, check the “Show Bookmarks” checkbox, as in image below:

Show Bookmarks
Show Bookmarks

To Insert a Bookmark,

select the bookmark location text, then go to Insert Tab from ribbon, Links Section – Bookmark command; type the names from Excel Map Table – column A names and click Add. You should be able to see the square brackets that defines a bookmark surrounding your selected text. (that text will be replaced with the values sent from Excel defined names).

To see the list of Bookmarks, use the Ctrl+G (Go To) shortcut, and select Bookmarks from list, like in image below:

Word doc Bookmarks list
Word doc Bookmarks list

There are 2 version of the code for creating the letters, one is for the Worksheet_Change Event, that will create letters only for the selected rows, and the code below, which will create letters for all visible rows from table; if there are no filters applied to table columns, a letter for each row will be created.

Here is the code:

Option Explicit

Sub CreateLetterForVisibleRows()

       Dim Fname As String, BMRange As Object, Cell As Range, DocNotOpen As Label, DocIsOpen As Label, FilePath As String, NewFileName As String
       Dim WdApp As Object, WdDoc As Object, Nm As String, ExitLine As Label, DestFolder As String, j As Integer, TblCell As Range
       Dim Source As Worksheet, NotFound As String, Check As Integer, ShowOnce As Boolean
       Set Source = Worksheets("Create Letters")
       
       DestFolder = "Letters"
       ShowOnce = False
      If Len(Dir(ThisWorkbook.Path & "\" & DestFolder, vbDirectory)) = 0 Then MkDir ThisWorkbook.Path & "\" & DestFolder
    
      DoEvents
  
     'open dialog window to select word document:
     Fname = Application.GetOpenFilename("Word files (*.do*),*.do*", , "Select Letter")
     If Fname = "False" Then Exit Sub
     FilePath = Left(Fname, InStrRev(Fname, "\"))
    
    Application.DisplayAlerts = False
    On Error Resume Next
    Set WdApp = GetObject(, "Word.Application")
    Err.Clear
    If WdApp Is Nothing Then
        Set WdApp = CreateObject("Word.Application")
        Set WdDoc = WdApp.Documents.Open(Fname)
    Else
        On Error GoTo DocNotOpen
        Set WdDoc = WdApp.Documents(Replace(Fname, FilePath, ""))
        GoTo DocIsOpen
DocNotOpen:
        Set WdDoc = WdApp.Documents.Open(Fname)
     End If

DocIsOpen:
Err.Clear
On Error GoTo 0
Application.DisplayAlerts = True

 'WdApp.Visible = True


      'create a letter for each selected rows:
      For Each TblCell In Source.ListObjects("MailMergeTable").ListColumns("Recipient Name").DataBodyRange
             If Not TblCell.RowHeight = 0 Then
                        'send data to Map Table:
                        Range("RecipientName") = Source.Cells(TblCell.Row, Source.Range("MailMergeTable[[#Headers],[Recipient Name]]").Column)
                        Range("RecipientTitle") = Source.Cells(TblCell.Row, Source.Range("MailMergeTable[[#Headers],[Recipient Title]]").Column)
                        Range("RecipientCompany") = Source.Cells(TblCell.Row, Source.Range("MailMergeTable[[#Headers],[Recipient Company]]").Column)
                        Range("RecipientCompanyAddress") = Source.Cells(TblCell.Row, Source.Range("MailMergeTable[[#Headers],[Recipient Company Address]]").Column)
                        Range("RecipientEmail") = Source.Cells(TblCell.Row, Source.Range("MailMergeTable[[#Headers],[Email]]").Column)
                        
                         'fill date to table:
                        Source.Cells(TblCell.Row, Source.Range("MailMergeTable[[#Headers],[Letter Date]]").Column) = Now()
                        
                        'fill data in bookmarks from Map Table
                        NotFound = ""
                        For Each Cell In Range("Map[Field]")
                               For j = 1 To WdDoc.BookMarks.Count
                                      Nm = WdDoc.BookMarks(j).Name
                                      Set BMRange = WdDoc.BookMarks(j).Range
                                      If InStr(Nm, Cell.Text) > 0 Then
                                              BMRange.Text = Cell.Offset(0, 1).Text
                                              WdDoc.BookMarks.Add Nm, BMRange
                                              Check = 1
                                      End If
                               Next j
                               If Check = 0 Then NotFound = NotFound & vbCrLf & Cell
                               Check = 0
                         Next Cell


                        If Len(NotFound) > 0 And ShowOnce = False Then
                             ShowOnce = True
                             NotFound = Right(NotFound, Len(NotFound) - 1)
                             MsgBox "There are fields that do not have a correspondent bookmark in  " & Replace(Fname, FilePath, "") & vbCrLf & _
                             "These fields are: " & vbCrLf & NotFound
                        End If

                        NewFileName = ThisWorkbook.Path & "\" & DestFolder & "\" & ValidateName(Range("RecipientName") & " " & Range("RecipientTitle")) & " " & Format(Now(), "yyyy-mm-dd-hh-mm") & ".pdf"
                        WdDoc.ExportAsFixedFormat OutputFileName:=NewFileName, _
                                        ExportFormat:=17, OpenAfterExport:=False, OptimizeFor:=0, Range:=0, _
                                        Item:=0, IncludeDocProps:=True, KeepIRM:=True, _
                                        CreateBookmarks:=0, DocStructureTags:=True, _
                                        BitmapMissingFonts:=True, UseISO19005_1:=False
             End If
      Next TblCell


ExitLine:
WdDoc.Close False
WdApp.Quit
Set WdApp = Nothing
Set WdDoc = Nothing
End Sub

Function ValidateName(ByVal txt As String) As String
Dim Char, Result As String, Pos As Integer
   Result = ""
   Char = ""
   Const ValidChars As String = "[A-Z,a-z,0-9, ,_,.,-]"
   
     For Pos = 1 To Len(txt)
            Char = Mid(txt, Pos, 1)
            If Char Like ValidChars Then Result = Result & Char
     Next
ValidateName = Result
End Function

Another very important thing you should always do:

Have fun, this solution will work for you, now you will have more time. Spend it wisely… 🙂

17 Comments to Use Excel to Create Mass Letters

  1. Tony says:

    I tried replicating this code but im getting a DEBUG Error when i goes to the following code:

    For Each Cell In Range(“Map[Field]”)

    Run-time error ‘1004’:
    Method ‘Range’ of object’_Global failed.

    I have a range called Map so i dont understand why it doesnt work.

    Thanks
    Tony

    • Hi Tony,
      That Map name refers to a Range or a defined table? Range(“Map[Field]”) is referring to a column in table, not to a normal named range.
      If data is just in normal cells, not in a defined table, the table range syntax will not work, you will have to select that column and name it MapField for example, Range(“MapField”) will work in this case.
      Or make a table from those cells.

      • tony says:

        Thanks Catalin
        thanks i will try that.
        Looking at your code, i can’t see where you have defined your Map[Field] which is why i got stuck since i have limited experience in defining fields etc.
        In your Map Table sheets, are you saying the data in there is formatted as a table which is why you didnt need to define it?

        cheers
        Tony

  2. Tony says:

    Hi Catalin

    If i only wanted to create one PDF (like Word Mail Merge) for all the letters instead of many PDFs , how would I change that part of the code?

    Thanks Again!
    Tony

  3. keeema says:

    how to save the letter in Word?

    • Hi,
      NewFileName should end up with “.docx” instead of “.pdf”, and instead of WdDoc.ExportasFixedFormat you should use:
      WdDoc.SaveAs FileName:=NewFileName, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False

  4. Nick says:

    When using the samples I get an Error 52 on line
    If Len(Dir(ThisWorkbook.Path & “\” & DestFolder, vbDirectory)) = 0 Then MkDir ThisWorkbook.Path & “\” & DestFolder

  5. Nick says:

    Sorry for delay, got pulled for another project. I tried documents and desktop and get same error.

  6. Jason says:

    I know this is obvious, but where does it save the documents at?

    • Hi Jason,
      The destination folder, if you read the code, is in the same folder where the excel file is saved, in a new folder named “Letters”:
      DestFolder = “Letters”
      ThisWorkbook.Path & “\” & DestFolder

      Cheers,
      Catalin

  7. GM says:

    Worked like a charm. Thanks a lot for posting this very useful utility. I started from scratch not knowing anything but basics of coding. But was able to do it with the instructions easily.

Leave a Reply

Your email address will not be published. Required fields are marked *

The Excel Learning Journey that I propose for you, is structured in such a way as to offer you the most practical way to learn Excel, free.

Start Your Free Excel Learning Journey!

Enter your email address to subscribe to this blog: