Sub BulkFindReplace()
Application.ScreenUpdating = False
Dim FRDoc As Document, FRList, i As Long
 'Load the strings from the reference doc into a text string to be used as an array.
Set FRDoc = Documents.Open("Drive:\FilePath\FindReplaceList.doc", ReadOnly:=True, Addtorecentfiles:=False, Visible:=False)
FRList = FRDoc.Range.Text
FRDoc.Close False
Set FRDoc = Nothing
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "<desc></desc>"
  .Forward = True
   'Process each entry from the source list.
  For i = 0 To UBound(Split(FRList, vbCr)) - 1
    .Replacement.Text = Split(FRList, vbCr)(i)
    .Execute Replace:=wdReplaceOne
  Next
End With
Application.ScreenUpdating = True
End Sub