How to mail merge with excel vba

Below is a project that I was recently working on. It steps through a sheet (by rows) and produces a word document for each row of data by way of a bookmarked word document. My excel sheet has 5 columns (Name, Address, City, State and Zip). The loop is driven by the "Name" column so it will loop for the number of names that are in the sheet.

'General Declarations

Dim RowCount As Integer
Dim DocCount As Integer

'These are the ranges that will correspond to
'my bookmarks in my word document
Dim cName As Range, cAddress As Range, _
cCity As Range, cState As Range, cZip As Range



Sub CreateDocs()
CountMyRows     'Uses CountMyRows() from below
Range("A1").Select     'Sets my startup point in the header row
Dim i As Integer
i = 1
DocCount = 1
Do While i <= RowCount
    CreateDoc
    DocCount = DocCount + 1
    i = i + 1
    ActiveCell.Offset(1, 0).Select
Loop

End Sub

Private Sub CountMyRows()

Range("a:a").Select

RowCount = (Selection.CurrentRegion.Rows.Count - 1)

If MsgBox("This action will produce " & _

    RowCount & " document(s). Are you " & _

    "sure that you want to proceed?" _

    , vbYesNo, "Are you sure?") = vbYes Then

    'Continue

    Else

    End

    End If

MsgBox (RowCount)

End Sub

Private Sub CreateDoc()
Set cName = ActiveCell.Offset(1, 0)
Set cAddress = ActiveCell.Offset(1, 1)
Set cCity = ActiveCell.Offset(1, 2)
Set cState = ActiveCell.Offset(1, 3)
Set cZip = ActiveCell.Offset(1, 4)

Dim NewApp As Object
Dim NewDoc As Object
    On Error Resume Next
    Set NewApp = GetObject(, "Word.Application")
    If NewApp Is Nothing Then
        Set NewApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
     If NewApp Is Nothing Then
          MsgBox ("This file is probably already open." & _
               "If so, please close it.")
     End If
    With NewApp
        .Visible = True
        Set NewDoc = .Documents.Open("C:\Temp\Doc1.docx")
        With NewDoc
                .Bookmarks("Name").Range.Text = cName.Text
                .Bookmarks("Address").Range.Text = cAddress.Text
                .Bookmarks("City").Range.Text = cCity.Text
                .Bookmarks("State").Range.Text = cState.Text
                .Bookmarks("Zip").Range.Text = cZip.Text
         End With
         NewDoc.SaveAs Filename:="Doc_" & DocCount & ".docx", _
                  FileFormat:=wdFormatXMLDocument, _
                  LockComments:=False, Password:="", _
                  AddToRecentFiles:=True, WritePassword:="", _
                  ReadOnlyRecommended:=False, _
                  EmbedTrueTypeFonts:=False, _
                  SaveNativePictureFormat:=False, _
                  SaveFormsData:=False, _
                  SaveAsAOCELetter:=False
         NewDoc.Close
    End With
    Set NewDoc = Nothing
    Set NewApp = Nothing
End Sub