Using Mail Merge to populate some fields in Word document

G

Guest

Hello,

What I am trying to accomplish is allowing users to click on a button from
an access form and activate a mail merge into a protected form field word
document.
(Some of the fields carry the access data, and some need to remain form
fields for the user to manipulate.)

Everything is working correctly the first time I click the button, but the
second time I try to activate the merge it fails. (If I close out of access
and then reopen it, it works again on the first pass. The line it stops on is
Selection.TypeText "<" & fFieldText(1, iCount) & "PlaceHolder>")
Any ideas on what I can do to fix this?

Here is my coding:

Function MergeIt()

Dim fFieldText() As String
Dim iCount As Integer
Dim fField As FormField
Dim sWindowMain, sWindowMerge As String
Dim objWord As Word.Document

iCount = 0

Set objWord =
GetObject("\\apl20tfp01\share\Database\Access\SBC\testformtest.doc",
"Word.Document")
objWord.Application.Visible = True
objWord.Activate

If objWord.Application.ActiveDocument.ProtectionType <> wdNoProtection Then
objWord.Application.ActiveDocument.Unprotect
End If


' Loop through all text form fields
' in the main mail merge document.
For Each aField In objWord.Application.ActiveDocument.FormFields

' If the form field is a text form field...
If aField.Type = wdFieldFormTextInput Then

' Redim array to hold contents of text field.
ReDim Preserve fFieldText(1, iCount + 1)

' Place content and name of field into array.
fFieldText(0, iCount) = aField.Result
fFieldText(1, iCount) = aField.Name

' Select the form field.
aField.Select

' Replace it with placeholder text. (This is the line where it errors
on the second pass through......)
Selection.TypeText "<" & fFieldText(1, iCount) & "PlaceHolder>"

' Increment icount
iCount = iCount + 1

End If

Next aField

' Set the mail merge data source.
objWord.MailMerge.OpenDataSource _
Name:="\\apl20tfp01\share\Database\Access\SBC" & _
"\SBCTest.mdb", _
LinkToSource:=True, _
Connection:="TABLE tblTestForm", _
SQLStatement:="SELECT * FROM [tblTestForm]"

' Execute the mail merge.
objWord.MailMerge.Destination = wdSendToNewDocument
objWord.MailMerge.Execute

' Find and Replace placeholders with form fields.
doFindReplace iCount, fField, fFieldText()

' Protect the merged document.
objWord.Application.ActiveDocument.Protect Password:="", NoReset:=True, _
Type:=wdAllowOnlyFormFields

objWord.Close (0)
Set objWord = Nothing

End Function

Sub doFindReplace(iCount As Integer, fField As FormField, _
fFieldText() As String)

' Go to top of document.
Selection.HomeKey Unit:=wdStory

' Initialize Find.
Selection.Find.ClearFormatting

With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

' Loop form fields count.
For i = 0 To iCount

' Execute the find.
Do While .Execute(FindText:="<" & fFieldText(1, i) _
& "PlaceHolder>") = True

' Replace the placeholder with the form field.
Set fField = Selection.FormFields.Add _
(Range:=Selection.Range, Type:=wdFieldFormTextInput)

' Restore form field contents and bookmark name.
fField.Result = fFieldText(0, i)
fField.Name = fFieldText(1, i)
Loop

' Go to top of document for next find.
Selection.HomeKey Unit:=wdStory

Next
End With

End Sub


Thanks,
 
L

Linda Burnside

The exact code for the idea I will suggest is beyond my skill level, but
here's a train of thought. It sounds like it throws an error when it finds
the original document open already. You could try having it check for an
open document first, and if it finds it open, make a new one with a
different name. Happy coding.

Linda

Robin B said:
Hello,

What I am trying to accomplish is allowing users to click on a button from
an access form and activate a mail merge into a protected form field word
document.
(Some of the fields carry the access data, and some need to remain form
fields for the user to manipulate.)

Everything is working correctly the first time I click the button, but the
second time I try to activate the merge it fails. (If I close out of
access
and then reopen it, it works again on the first pass. The line it stops on
is
Selection.TypeText "<" & fFieldText(1, iCount) & "PlaceHolder>")
Any ideas on what I can do to fix this?

Here is my coding:

Function MergeIt()

Dim fFieldText() As String
Dim iCount As Integer
Dim fField As FormField
Dim sWindowMain, sWindowMerge As String
Dim objWord As Word.Document

iCount = 0

Set objWord =
GetObject("\\apl20tfp01\share\Database\Access\SBC\testformtest.doc",
"Word.Document")
objWord.Application.Visible = True
objWord.Activate

If objWord.Application.ActiveDocument.ProtectionType <> wdNoProtection
Then
objWord.Application.ActiveDocument.Unprotect
End If


' Loop through all text form fields
' in the main mail merge document.
For Each aField In objWord.Application.ActiveDocument.FormFields

' If the form field is a text form field...
If aField.Type = wdFieldFormTextInput Then

' Redim array to hold contents of text field.
ReDim Preserve fFieldText(1, iCount + 1)

' Place content and name of field into array.
fFieldText(0, iCount) = aField.Result
fFieldText(1, iCount) = aField.Name

' Select the form field.
aField.Select

' Replace it with placeholder text. (This is the line where it errors
on the second pass through......)
Selection.TypeText "<" & fFieldText(1, iCount) & "PlaceHolder>"

' Increment icount
iCount = iCount + 1

End If

Next aField

' Set the mail merge data source.
objWord.MailMerge.OpenDataSource _
Name:="\\apl20tfp01\share\Database\Access\SBC" & _
"\SBCTest.mdb", _
LinkToSource:=True, _
Connection:="TABLE tblTestForm", _
SQLStatement:="SELECT * FROM [tblTestForm]"

' Execute the mail merge.
objWord.MailMerge.Destination = wdSendToNewDocument
objWord.MailMerge.Execute

' Find and Replace placeholders with form fields.
doFindReplace iCount, fField, fFieldText()

' Protect the merged document.
objWord.Application.ActiveDocument.Protect Password:="", NoReset:=True, _
Type:=wdAllowOnlyFormFields

objWord.Close (0)
Set objWord = Nothing

End Function

Sub doFindReplace(iCount As Integer, fField As FormField, _
fFieldText() As String)

' Go to top of document.
Selection.HomeKey Unit:=wdStory

' Initialize Find.
Selection.Find.ClearFormatting

With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

' Loop form fields count.
For i = 0 To iCount

' Execute the find.
Do While .Execute(FindText:="<" & fFieldText(1, i) _
& "PlaceHolder>") = True

' Replace the placeholder with the form field.
Set fField = Selection.FormFields.Add _
(Range:=Selection.Range, Type:=wdFieldFormTextInput)

' Restore form field contents and bookmark name.
fField.Result = fFieldText(0, i)
fField.Name = fFieldText(1, i)
Loop

' Go to top of document for next find.
Selection.HomeKey Unit:=wdStory

Next
End With

End Sub


Thanks,
Click to expand...
 
G

Guest

Linda,

Thanks for the thought, but I close the main document in my coding, the only
document that can be left open is the new document it creates for the mail
merge.

I was thinking along the same lines, but think somehow the document remains
locked for editing or something..
--
Robin Barrett


Linda Burnside said:
The exact code for the idea I will suggest is beyond my skill level, but
here's a train of thought. It sounds like it throws an error when it finds
the original document open already. You could try having it check for an
open document first, and if it finds it open, make a new one with a
different name. Happy coding.

Linda

Robin B said:
Hello,

What I am trying to accomplish is allowing users to click on a button from
an access form and activate a mail merge into a protected form field word
document.
(Some of the fields carry the access data, and some need to remain form
fields for the user to manipulate.)

Everything is working correctly the first time I click the button, but the
second time I try to activate the merge it fails. (If I close out of
access
and then reopen it, it works again on the first pass. The line it stops on
is
Selection.TypeText "<" & fFieldText(1, iCount) & "PlaceHolder>")
Any ideas on what I can do to fix this?

Here is my coding:

Function MergeIt()

Dim fFieldText() As String
Dim iCount As Integer
Dim fField As FormField
Dim sWindowMain, sWindowMerge As String
Dim objWord As Word.Document

iCount = 0

Set objWord =
GetObject("\\apl20tfp01\share\Database\Access\SBC\testformtest.doc",
"Word.Document")
objWord.Application.Visible = True
objWord.Activate

If objWord.Application.ActiveDocument.ProtectionType <> wdNoProtection
Then
objWord.Application.ActiveDocument.Unprotect
End If


' Loop through all text form fields
' in the main mail merge document.
For Each aField In objWord.Application.ActiveDocument.FormFields

' If the form field is a text form field...
If aField.Type = wdFieldFormTextInput Then

' Redim array to hold contents of text field.
ReDim Preserve fFieldText(1, iCount + 1)

' Place content and name of field into array.
fFieldText(0, iCount) = aField.Result
fFieldText(1, iCount) = aField.Name

' Select the form field.
aField.Select

' Replace it with placeholder text. (This is the line where it errors
on the second pass through......)
Selection.TypeText "<" & fFieldText(1, iCount) & "PlaceHolder>"

' Increment icount
iCount = iCount + 1

End If

Next aField

' Set the mail merge data source.
objWord.MailMerge.OpenDataSource _
Name:="\\apl20tfp01\share\Database\Access\SBC" & _
"\SBCTest.mdb", _
LinkToSource:=True, _
Connection:="TABLE tblTestForm", _
SQLStatement:="SELECT * FROM [tblTestForm]"

' Execute the mail merge.
objWord.MailMerge.Destination = wdSendToNewDocument
objWord.MailMerge.Execute

' Find and Replace placeholders with form fields.
doFindReplace iCount, fField, fFieldText()

' Protect the merged document.
objWord.Application.ActiveDocument.Protect Password:="", NoReset:=True, _
Type:=wdAllowOnlyFormFields

objWord.Close (0)
Set objWord = Nothing

End Function

Sub doFindReplace(iCount As Integer, fField As FormField, _
fFieldText() As String)

' Go to top of document.
Selection.HomeKey Unit:=wdStory

' Initialize Find.
Selection.Find.ClearFormatting

With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

' Loop form fields count.
For i = 0 To iCount

' Execute the find.
Do While .Execute(FindText:="<" & fFieldText(1, i) _
& "PlaceHolder>") = True

' Replace the placeholder with the form field.
Set fField = Selection.FormFields.Add _
(Range:=Selection.Range, Type:=wdFieldFormTextInput)

' Restore form field contents and bookmark name.
fField.Result = fFieldText(0, i)
fField.Name = fFieldText(1, i)
Loop

' Go to top of document for next find.
Selection.HomeKey Unit:=wdStory

Next
End With

End Sub


Thanks,
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Problem with Merge to Word document with Fields 2
Word mail merge code problem 2
Populate Word document with command button on Access form 2
Word Merge and 3
Activate Open Document 0
Merge with Word: memo field too long for string 6
Creating a mail merge document using C#. 6
unlink fields in a Word document from Access VBA 2

Top