Here is a method to process just the active document. You can revise to suit processing an entire folder using Paul's code for an example:
Code:
Option Explicit
Sub FRWithDefinedHyperlinks()
Dim strDataSourcePath As String, strWorksheet As String
Dim strSQL As String
Dim oVBA_LB As Object
Dim lngIndex As Long
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
Dim oRng As Range
strDataSourcePath = "D:\FRList.xlsx": strWorksheet = "Sheet1"
If Dir(strDataSourcePath) = "" Then
MsgBox "Cannot find the designated workbook: " & strDataSourcePath, vbExclamation
Exit Sub
End If
'Get all data from sheet named "Sheet1", exclude heading row
strSQL = "SELECT * FROM [" & strWorksheet & "$];"
'Create a Listbox object to hold data
Set oVBA_LB = CreateObject("New:{8BD21D20-EC42-11CE-9E0D-00AA006002F3}")
xlFillList oVBA_LB, strDataSourcePath, "True", strSQL
Application.ScreenUpdating = False
Set wdDoc = ActiveDocument
'Process each word from the F/R List
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindContinue
For lngIndex = 0 To oVBA_LB.ListCount - 1
.Text = oVBA_LB.List(lngIndex, 0)
While .Execute
wdDoc.Hyperlinks.Add Anchor:=oRng, _
Address:=oVBA_LB.List(lngIndex, 2), _
ScreenTip:=oVBA_LB.List(lngIndex, 3), _
TextToDisplay:=oVBA_LB.List(lngIndex, 1)
Wend
Next
End With
Set wdDoc = Nothing: Set oVBA_LB = Nothing
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub
Public Function xlFillList(oListOrComboBox As Object, strWorkbook As String, _
bSuppressHeader As Boolean, strSQL As String)
Dim oConn As Object
Dim oRecordSet As Object
Dim lngNumRecs As Long, lngIndex As Long
Dim strWidth As String
Dim strConnection As String
'Create connection:
Set oConn = CreateObject("ADODB.Connection")
If bSuppressHeader Then
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
Else
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
End If
oConn.Open ConnectionString:=strConnection
Set oRecordSet = CreateObject("ADODB.Recordset")
'Read the data from the worksheet.
oRecordSet.Open strSQL, oConn, 3, 1 '3: adOpenStatic, 1: adLockReadOnly
With oRecordSet
'Find the last record.
.MoveLast
'Get count.
lngNumRecs = .RecordCount
'Return to the start.
.MoveFirst
End With
With oListOrComboBox
.Clear
'Load the records into the columns of the named list/combo box.
.ColumnCount = oRecordSet.Fields.Count
.Column = oRecordSet.GetRows(lngNumRecs)
strWidth = vbNullString
End With
Cleanup:
If oRecordSet.State = 1 Then oRecordSet.Close
Set oRecordSet = Nothing
If oConn.State = 1 Then oConn.Close
Set oConn = Nothing
lbl_Exit:
Exit Function
End Function
Using data arranged like: