View Single Post
 
Old 09-30-2022, 04:04 PM
macropod's Avatar
macropod macropod is offline Windows 10 Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
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

Quote:
Originally Posted by Jen75 View Post
The content does differ in all of the pages of the Word document. Each page is unique to a single person.
In that case, it would have been preferable to have the variable content in the data source also.

However, since you well and truly passed that point, try the following macro:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim iDataRow As Long, xlFndList As String, xlRepList As String, i As Long
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\Employees.xlsx"
StrWkSht = "Sheet1"
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
            xlFndList = xlFndList & "|" & Trim(.Range("A" & i))
            xlRepList = xlRepList & "|" & 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 xlFndList = "" Then Exit Sub
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Wrap = wdFindContinue
  .MatchWholeWord = True
  .Text = "^w^p"
  .Replacement.Text = "^p"
  .Execute Replace:=wdReplaceAll
  'Process each string from the List
  For i = 1 To UBound(Split(xlFndList, "|"))
    .Text = Split(xlFndList, "|")(i) & vbCr & "ID Field:"
    .Replacement.Text = "^& " & Split(xlRepList, "|")(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub

Function SheetExists(xlWkBk As Object, SheetName As String) As Boolean
Dim i As Long: SheetExists = False
For i = 1 To xlWkBk.Sheets.Count
  If xlWkBk.Sheets(i).Name = SheetName Then
    SheetExists = True:   Exit For
  End If
Next
End Function
As coded, the macro assumes the:
• data are in a workbook named 'Employees.xlsx' in your documents folder;
• data are in a worksheet named 'Sheet1';
• employee names in the document are found in column A of the worksheet; and
• employee IDs to be used in the document are found in column B of the worksheet.
You can edit the code to match whatever your actual scenario is.

I note that your sample document is inconsistent regarding the presence of a space after 'ID Field:'. The macro has been coded to work around that by eliminating any white-space before paragraph breaks, then reinserting a space before the ID.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote