View Single Post
 
Old 03-29-2012, 04:42 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,370
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Nancy,

If you make the links, then save the file as a template, then all you'll need to do is to when you want an updated document is to create one based on the template, then press Ctrl-A, F9, Ctrl-Shift-F9 to update all the links in the document, then break the links and turn the results into plain text. You can then save the document. That is much more efficient than using a macro.

As I said regarding the macro, it would need some changes to suit your needs. Since you seem to have your heart set on using a macro, try:
Code:
Sub BulkFindReplace()
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, Rslt
Dim iDataRow As Long, xlFList As String, xlRList As String, i As Long
Const StrWkSht As String = "Sheet1"
StrWkBkNm = "C:\Users\Username\Documents\Workbook Name.xls"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
On Error Resume Next
'Start Excel
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
  MsgBox "Can't start Excel.", vbExclamation
  Exit Sub
End If
On Error GoTo 0
With xlApp
  'Hide our Excel session
  .Visible = False
  ' The file is available, so open it.
  Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, ReadOnly:=True, AddToMru:=False)
  If xlWkBk Is Nothing Then
    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
    .Quit
    Exit Sub
  End If
  ' Process the workbook.
  With xlWkBk
    'Ensure the worksheet exists
    If SheetExists(xlWkBk, StrWkSht) = True Then
      With .Worksheets(StrWkSht)
        ' Find the last-used row in column A.
        iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
        ' Capture the F/R 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
    Else
      MsgBox "Cannot find the designated worksheet: " & StrWkSht, vbExclamation
    End If
  .Close False
  End With
  .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Exit if there are no data
If xlFList = "" Then Exit Sub 
'Process each word from the List
For i = 1 To UBound(Split(xlFList, "|"))
  With ActiveDocument.Range
    With .Find
      .Text = Split(xlFList, "|")(i)
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWholeWord = True
      .MatchCase = True
      .Wrap = wdFindStop
      .Execute
    End With
    'Replace the found text, asking first
    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
End Sub
 
Function SheetExists(xlWkBk As Object, SheetName As String) As Boolean
Dim i As Long: SheetExists = False
With xlWkBk
  For i = 1 To .Sheets.Count
    If .Sheets(i).Name = SheetName Then
      SheetExists = True:   Exit For
    End If
  Next
End With
End Function
You will need to change the StrWkBkNm and StrWkSht variables to point to your own workbook and worksheet, respectively.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote