Excel/Word Merge

[brianlb]

I have a word merge I'm doing w/Excel as the data source. I have to create a macro w/VBA code for the merge because some of the fields in word text and dropdown boxes. I'm using word and excel 2000. The merge works if I'm using just a small amount of data from excel. Usually the merge is going to be 100 or less merge enteries(pages) . But if I try to do more it gets hung up and stops. For example if I tried to have 1000 entries it woudln't complete the mrege. My code is below if anyone is able to assist in why this hangs up. Thanks

Sub PreserveMailMergeFormFieldsNewDoc()

Dim fFieldText() As String
Dim iCount As Integer
Dim fField As FormField
Dim sWindowMain, sWindowMerge As String

On Error GoTo ErrHandler

' Store Main merge document window name.
sWindowMain = ActiveWindow.Caption

' Because the document contains form fields,
' it should be protected, so unprotect document.
If ActiveDocument.ProtectionType <> wdNoProtection Then
   ActiveDocument.Unprotect
End If

' Loop through all text form fields
' in the main mail merge document.
For Each aField In 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.
      Selection.TypeText "<" & fFieldText(1, iCount) & "PlaceHolder>"

      ' Increment icount
      iCount = iCount + 1

   End If

Next aField

' Perform mail merge to new document.
ActiveDocument.MailMerge.Destination = wdSendToNewDocument
ActiveDocument.MailMerge.Execute

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

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

' Get name of final merged document.
sWindowMerge = ActiveWindow.Caption

' Reactivate the main merge document.
Windows(sWindowMain).Activate

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

' Reprotect the main mail merge document.
ActiveDocument.Protect Password:="", NoReset:=True, _
   Type:=wdAllowOnlyFormFields

' Switch back to the merged document.
Windows(sWindowMerge).Activate

ErrHandler:

End Sub


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