I am trying to merge a query with a Word document based on a template but it seems to limit the number of fields I can use. Unfortunately I have to merge 101 fields which are in the query but don't seem to reach the merged document and I get Word mail merge errors telling the field is not in the data source. This is my code, I am passing the template name to the function as DocumentName from a command button on a form and I am using Access/WordXP. Can anyone suggest how I can resolve this issue. All help gratefully received.
Public Sub MergeDocument(DocumentName)
' function to produce selected labels based on the qLabels query
Dim NewDocPath As String
Dim objWord As Word.Application, DocName As String
DoCmd.Hourglass True
On Error Resume Next
Set objWord = GetObject(, "Word.Application"
If objWord Is Nothing Then
Set objWord = New Word.Application
If objWord Is Nothing Then
MsgBox "Microsoft Word is not installed on your computer"
End If
End If
On Error GoTo ErrorHandler
' save record first
DoCmd.RunCommand acCmdSaveRecord
' set the path to the templates folder
NewDocPath = "S:\Labels DB\LabelTemplates\" & DocumentName
DoCmd.OutputTo acOutputQuery, "qLabels", acFormatRTF, "S:\Labels DB\MergeDB.doc"
objWord.Documents.Add (NewDocPath)
DocName = objWord.ActiveDocument.Name
With objWord.ActiveDocument.MailMerge
.OpenDataSource "S:\Labels DB\MergeDB.doc"
.Destination = wdSendToNewDocument
.Execute
End With
objWord.Documents(DocName).Close False
DoCmd.Hourglass False
objWord.Visible = True
objWord.Activate
Set objWord = Nothing
Exit Sub
ErrorHandler:
DoCmd.Hourglass False
If Err.Number = 2302 Then
MsgBox "It looks like you are already using the data needed for the mail merge in another application." _
& vbCrLf & vbCrLf & "Try closing all your Microsoft Word documents and try again.", vbInformation, "Nothing to worry about"
Else
MsgBox "It looks like we have a problem. Please write down the error number and what you were doing then call technical support." _
& vbCrLf & vbCrLf & "Error number: " & Err.Number & " and Description: " & Error, vbExclamation, "This could be serious"
End If
objWord.Visible = True
Set objWord = Nothing
End Sub
Public Sub MergeDocument(DocumentName)
' function to produce selected labels based on the qLabels query
Dim NewDocPath As String
Dim objWord As Word.Application, DocName As String
DoCmd.Hourglass True
On Error Resume Next
Set objWord = GetObject(, "Word.Application"
If objWord Is Nothing Then
Set objWord = New Word.Application
If objWord Is Nothing Then
MsgBox "Microsoft Word is not installed on your computer"
End If
End If
On Error GoTo ErrorHandler
' save record first
DoCmd.RunCommand acCmdSaveRecord
' set the path to the templates folder
NewDocPath = "S:\Labels DB\LabelTemplates\" & DocumentName
DoCmd.OutputTo acOutputQuery, "qLabels", acFormatRTF, "S:\Labels DB\MergeDB.doc"
objWord.Documents.Add (NewDocPath)
DocName = objWord.ActiveDocument.Name
With objWord.ActiveDocument.MailMerge
.OpenDataSource "S:\Labels DB\MergeDB.doc"
.Destination = wdSendToNewDocument
.Execute
End With
objWord.Documents(DocName).Close False
DoCmd.Hourglass False
objWord.Visible = True
objWord.Activate
Set objWord = Nothing
Exit Sub
ErrorHandler:
DoCmd.Hourglass False
If Err.Number = 2302 Then
MsgBox "It looks like you are already using the data needed for the mail merge in another application." _
& vbCrLf & vbCrLf & "Try closing all your Microsoft Word documents and try again.", vbInformation, "Nothing to worry about"
Else
MsgBox "It looks like we have a problem. Please write down the error number and what you were doing then call technical support." _
& vbCrLf & vbCrLf & "Error number: " & Err.Number & " and Description: " & Error, vbExclamation, "This could be serious"
End If
objWord.Visible = True
Set objWord = Nothing
End Sub
