Macro for replacing EXCEL data into WORD

[macropod]

The following Word macro allows you to use an Excel Workbook to hold Find/Replace strings as the source for a large-scale Find/Replace operation. In this example, the macro finds the strings referred to in column A and replaces them with the strings referred to in column B. The user has the option to skip particular found strings, or to cancel the process altogether. Comments in the code show how to make the processing automatic (ie no user intervention). The bulk of the code (around 80%) is for managing the Excel session.

Sub BulkFindReplace()
Application.ScreenUpdating = True
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
Dim xlFList As String, xlRList As String, i As Long, Rslt
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\Workbook Name.xls"
StrWkSht = "Sheet1"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
' Test whether Excel is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Excel, so we can close it later.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
  Set xlApp = CreateObject("Excel.Application")
  If xlApp Is Nothing Then
    MsgBox "Can't start Excel.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Excel.
  bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
  'Hide our Excel session
  If bStrt = True Then .Visible = False
  For Each xlWkBk In .Workbooks
    If xlWkBk.FullName = StrWkBkNm Then ' It's open
      Set xlWkBk = xlWkBk
      bFound = True
      Exit For
    End If
  Next
  ' If not open by the current user.
  If bFound = False Then
  ' Check if another user has it open.
  If IsFileLocked(StrWkBkNm) = True Then
  ' Report and exit if true
  MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
  If bStrt = True Then .Quit
    Exit Sub
  End If
  ' The file is available, so open it.
  Set xlWkBk = .Workbooks.Open(Filename:=StrWkBkNm)
  If xlWkBk Is Nothing Then
    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
    If bStrt = True Then .Quit
    Exit Sub
  End If
End If
' Process the workbook.
With xlWkBk.Worksheets(StrWkSht)
  ' Find the last-used row in column A.
  ' Add 1 to get the next row for data-entry.
  iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
  ' Output the captured data.
  For i = 1 To iDataRow
    ' Skip over empty fields to preserve the underlying cell contents.
    If Trim(.Range("A" & i)) <> vbNullString Then
      xlFList = xlFList & "|" & Trim(.Range("A" & i))
      xlRList = xlRList & "|" & Trim(.Range("B" & i))
    End If
  Next
End With
If bFound = False Then xlWkBk.Close False
If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Process each word from the F/R List
For i = 1 To UBound(Split(xlFList, "|"))
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWholeWord = True
    .MatchCase = True
    .Wrap = wdFindStop
    .Text = Split(xlFList, "|")(i)
    .Execute
    'To automatically change the found text:
    '? comment-out/delete the previous line and the Do While Loop
    '? uncomment the next two lines
    '.Replacement.Text = Split(xlRList, "|")(i)
    '.Execute Replace:=wdReplaceAll
  End With
  'Ask the user whether to change the found text
  Do While .Find.Found
    .Duplicate.Select
    Rslt = MsgBox("Replace this instance of:" & vbCr & _
      Split(xlFList, "|")(i) & vbCr & "with:" & vbCr & _
      Split(xlRList, "|")(i), vbYesNoCancel)
    If Rslt = vbCancel Then Exit Sub
    If Rslt = vbYes Then .Text = Split(xlRList, "|")(i)
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Next
Application.ScreenUpdating = True
End Sub
'
Function IsFileLocked(strFileName As String) As Boolean
On Error Resume Next
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
IsFileLocked = Err.Number
Err.Clear
End Function

You will, of course, need to supply your own workbook name and, perhaps, part or all of its path.