![]() |
|
#2
|
||||
|
||||
|
Used in conjunction with Document Batch Processes the following custom process - AddHLinks - will add the links associated with the texts in your Worksheet.
Change the path of the workbook and the worksheet name as appropriate: Code:
Option Explicit
Const strWorkbook As String = "E:\Path\Example.xlsx" 'The path of the workbook
Const strSheet As String = "Sheet1" 'The name of the worksheet
Sub AddHLinks(oDoc As Document)
Dim Arr() As Variant
Dim i As Long
Dim oRng As Range
Dim sFindText As String
Dim sReplaceText As String
Arr = xlFillArray(strWorkbook, strSheet)
For i = 0 To UBound(Arr, 2)
sFindText = Arr(0, i)
sReplaceText = Arr(1, i)
Set oRng = oDoc.Range
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(findText:=sFindText, _
MatchWholeWord:=True, _
Forward:=True, _
Wrap:=wdFindStop) = True
oRng.Hyperlinks.Add oRng, sReplaceText
oRng.End = oRng.End + 1
oRng.Collapse wdCollapseEnd
DoEvents
Loop
End With
Next
lbl_Exit:
Exit Sub
End Sub
Private Function xlFillArray(strWorkbook As String, _
strRange As String) As Variant
'Graham Mayor - http://www.gmayor.com - 24/09/2016
Dim RS As Object
Dim CN As Object
Dim iRows As Long
strRange = strRange & "$]" 'Use this to work with a named worksheet
'strRange = strRange & "]" 'Use this to work with a named range
Set CN = CreateObject("ADODB.Connection")
'Set HDR=NO for no header row
CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"""
Set RS = CreateObject("ADODB.Recordset")
RS.Open "SELECT * FROM [" & strRange, CN, 2, 1
With RS
.MoveLast
iRows = .RecordCount
.MoveFirst
End With
xlFillArray = RS.GetRows(iRows)
If RS.State = 1 Then RS.Close
Set RS = Nothing
If CN.State = 1 Then CN.Close
Set CN = Nothing
lbl_Exit:
Exit Function
End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Export Word Data to Excel | anifa | Word | 2 | 12-11-2022 02:51 PM |
Word form with the intent of Excel export
|
Flyckten | Word VBA | 5 | 09-03-2018 05:34 AM |
VBA Export Data as Text from Excel to Word
|
lwbarnes | Word VBA | 3 | 06-09-2016 02:47 PM |
| Through VBA, export range from Excel to Word | duugg | Word VBA | 0 | 08-24-2009 07:50 PM |
| Word to Excel hyperlinks and spaces | gak | Word | 1 | 09-14-2008 08:38 AM |