Combining Mail Merge with Form Fields

The third example is potentially even more useful as it can be used with any valid data source. All the examples will work with a form similar to that shown in the illustrations and data sources that contain at least the three fieldnames. The only real proviso is that the third macro looks to the second paragraph on the form (here the Operator field content) to provide the names for the merged documents.

When the macro is run, the form is unprotected and the merge fields are replaced with docvariable fields

The docvariable fields are populated with the data from each record (below) in turn and each modified document is saved in a folder chosen from the macro.

           & vbCr & "or leave blank for no password.", "Protect Documents")
           If sPassword <> "" Then
                If InputBox("Confirm the password.", "Confirm Password") <> sPassword Then
                     MsgBox "The passwords do not match.", vbCritical + vbOKOnly
                     GoTo SavePass
                End If
           End If
     End If
     'Protect the forms
     .Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=sPassword

     'Access the data source and create an array containing the field names and
     'an array containing all of the data
     On Error Resume Next
     Set xlApp = GetObject(, "Excel.Application")
     If Err Then
          Excelwasnotrunning = True
          Set xlApp = CreateObject("Excel.Application")
     End If
     On Error GoTo ErrMsg
     With xlApp
          Set xlbook = .Workbooks.Open(dSource)
          MergeData = xlbook.Worksheets(qryStr).Range(.Cells(2, 1), .Cells(1 + numrecs, numflds))
          MergeFields = xlbook.Worksheets(qryStr).Range(.Cells(1, 1), .Cells(1, numflds))
          xlbook.Close SaveChanges:=False
          Set xlbook = Nothing
     End With
     If Excelwasnotrunning Then xlApp.Quit
     Set xlApp = Nothing
     'Iterate through the records in the datasource
     For j = 1 To numrecs
          'Create variables in the document with the names and values of the fields in each record
          For i = 1 To numflds
               If MergeData(j, i) <> "" Then
                    ActiveDocument.Variables(MergeFields(1, i)).Value = MergeData(j, i)
               Else
                    ActiveDocument.Variables(MergeFields(1, i)).Value = " "
               End If
          Next i
         'Update the fields in the document
         .Fields.Update
         'Save the document
         .SaveAs DocDir & "MwithFF" & j, AddtoRecentFiles:=False
     Next j
     .Close wdDoNotSaveChanges
End With
'Error Handler
ErrMsg:
If Err.Number > 0 Then
     MsgBox Err.Number & vbCr & Err.Description
     Exit Sub
End If
Exit Sub
NoPass:
MsgBox "The password is incorrect. Unable to complete the process", _
vbCritical, "Wrong password!"
End Sub
 

     If bProtected = True Then
          .Protect _
          Type:=wdAllowOnlyFormFields, _
          NoReset:=True, Password:=sPassword
     End If
End With
' Open the database
Set db = OpenDatabase(dSource)
' Retrieve the recordset
Set rs = db.OpenRecordset(qryStr)
With rs
     ' Move to the first record
     .MoveFirst
     j = 1
     Do While Not .EOF
          'Create variables in the document with the names
          'and values of the fields in each record
          For i = 0 To .Fields.Count - 1
               If .Fields(i).Value <> "" Then
                    ActiveDocument.Variables(.Fields(i).name).Value = _
                    .Fields(i).Value
               End If
          Next i
          With ActiveDocument
               .Fields.Update
               .SaveAs DocDir & "MwithFF" & j
          End With
          .MoveNext
          j = j + 1
     Loop
End With
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Sub
 

Sub MergefromAnyDataSourcewithFormFields()
Dim i As Long
Dim oDoc As Document
Dim DocName As String
Dim oRng As Range
Dim sPassword As String
Dim bProtected As Boolean
Dim fDialog As FileDialog
Dim bAddin As Boolean
Dim sAddin As String
bAddin = False
sAddin = Options.DefaultFilePath(wdStartupPath) _
& Chr(92) & "MMtoDocs*.dotm"
'Check if the splitmerge add-in is installed
On Error GoTo ErrorHandler
If AddIns(sAddin).Installed = True Then
     bAddin = True
     'and if it is turn it off
     AddIns(sAddin).Installed = False
End If
Folder:
'Pick a folder to save the files
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
sPassword = "" 'insert form password, if applicable, between quotes
With fDialog
     .Title = "Select Folder to store the documents and click OK"
     .AllowMultiSelect = False
     .InitialView = msoFileDialogViewList
     If .Show <> -1 Then
          MsgBox "Cancelled By User"
          Exit Sub
     End If
     DocDir = fDialog.SelectedItems.Item(1)
     If Right(DocDir, 1) <> "\" Then DocDir = DocDir + "\"
End With

Set oDoc = ActiveDocument
With oDoc
    'Unprotect the file
     If .ProtectionType <> wdNoProtection Then
          bProtected = True
          .Unprotect Password:=sPassword
     End If

     For i = .FormFields.Count To 1 Step -1
          If .FormFields(i).Type = wdFieldFormTextInput Then
               .FormFields(i).Range.Text = "FF" & i
          End If
     Next i
     With .MailMerge
          .Destination = wdSendToNewDocument
          .Execute
     End With
End With
oDoc.Close wdDoNotSaveChanges
Selection.HomeKey wdStory
With Selection.Find
     Do While .Execute(findText:="FF[0-9]{1,}", _
              Forward:=True, _
              MatchWildcards:=True, _
              Wrap:=wdFindStop, _
              MatchCase:=True) = True
     ActiveDocument.FormFields.Add _
              Selection.Range, _
              wdFieldFormTextInput
     Loop
End With
'Now split the document
Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
     ActiveDocument.Sections.First.Range.Cut
     Documents.Add
     'Documents are based on the Normal template
     'To use an alternative template follow the link.
     With Selection
          .Paste
          .EndKey Unit:=wdStory
          .MoveLeft Unit:=wdCharacter, Count:=1
          .Delete Unit:=wdCharacter, Count:=1
     End With
     'locate the position of the data in the document to
     'be used as a filename - here the 'Operator' in the
     'second paragraph
     Set oRng = ActiveDocument.Paragraphs(2).Range
     'remove the paragraph mark from the end of the range
     oRng.End = oRng.End - 1
     'Set the path and name of the document
     DocName = DocDir & oRng.Text
     'Protect the document for forms
     ActiveDocument.Protect _
            Type:=wdAllowOnlyFormFields, _
            NoReset:=True, Password:=sPassword
     'and save it
     ActiveDocument.SaveAs FileName:=DocName, _
            FileFormat:=wdFormatDocument, _
            AddToRecentFiles:=False
     ActiveWindow.Close
     Counter = Counter + 1
Wend
'If the splitmerge add-in was turned off earlier
'turn it on again
If bAddin = True Then
     AddIns(sAddin).Installed = True
End If
'close the now empty merged document without saving
ActiveDocument.Close wdDoNotSaveChanges
End
ErrorHandler:
If Err.Number = 5941 Then GoTo Folder
End Sub