Automating insertion of hyperlinks

[jimmysheedah]

Hi All,

I have been stumped by a problem and have been wondering on whether a solution is possible.

I have a word document which I have made references to other documents that I have saved as PDF's in the footnotes of the document. Now I want to insert hyperlinks whereever these documents have been referenced. I am trying to automate this process to avoid having to repeat the process is required again.

The approach I am taking is to save the reference and the hyperlink in excel and I am trying to use this data to create the hyperlinking. So say I have the following saved in excel:

Document: Path:
0110_00001 \0110_00001.pdf

What I am trying to acheive is to check if the document name appears anywhere within my word document and if so insert a hyperlink for the found text and have the path above as the hyperlink.

Any help or guidance in the right direction would be greatly appreciated.

Thanks in advance.

[jimmysheedah]

I have managed to put together a workable solution; not sure if there is a more efficient way to do this.

Sub InsertHyperlinks()

Dim arrExcelValues()
Dim arrExcelValues2()

Set ObjExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Book1.xslx")
objExcel.visible = True

i = 1
x = 0

Do Until objExcel.Cells(i, 1).Value = ""
ReDim Preserve arrExcelValues(x)
arrExcelValues(x) = objExcel.Cells(i, 1).Value
i = i + 1
x = x + 1
Loop

x = x - 1

Dim FileName As String
Dim filePath As String
Dim fileExte As String

j = 1
y = 0

Do Until objExcel.Cells(j, 2).Value = ""
ReDim Preserve arrExcelValues2(y)
arrExcelValues2(y) = objExcel.Cells(j, 2).Value
j = j + 1
y = y + 1
Loop

objExcel.Quit

Dim xlApp As Object

For i = 0 To x
fileName = arrExcelValues(i)
fileExte = arrExcelValues2(i)
filePath = "C:\Test\" & fileName & fileExte

With Selection.Find
.Text = fileName
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindCOntinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSOundsLike = False
.MatchAllWordForms = False
Ends With
Selection.Find.Execute
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=filePath, SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Text
SetxlApp = Nothing
Next

End Sub

Is there a nifty function that will let me feed the values in from the excel without opening it - so I can store in an array and use accordingly?
I do think it could be improved on but at the moment this requires a bit of background work before I can run the script. Any possible improvements would be greatly appreciated

[koolsid]

Welcome to the forums jimmysheedah

You can use this code to store the values from Excel into an array. This is comparatively fast as it doesn't loop though every cell but instead stores the range directly in the array. This code also correctly declares and releases your Excel Objects.

    Dim arrExcelValues As Variant, arrExcelValues2 As Variant
    Dim lRow As Long
    
    Dim objExcel As Object, objWorkbook As Object, objWorkSheet As Object
    
    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open("C:\Book1.xlsx")
    Set objWorkSheet = objWorkbook.Sheets("Sheet1")
    objExcel.Visible = False
    
    With objWorkSheet
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    
        arrExcelValues = .Range("A1:A" & lRow).Value
        
        '~~> Skip this line if the number of rows in B will the same
        '~~> as rows in A
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row
    
        arrExcelValues2 = .Range("B1:B" & lRow).Value
    End With
    
    objWorkbook.Close SaveChanges:=False
    Set objWorkSheet = Nothing
    Set objWorkbook = Nothing
    objExcel.Quit
    Set objExcel = Nothing

Once the data is in the array you can retrieve it using

        FileName = arrExcelValues(i, 1)
        fileExte = arrExcelValues2(i, 1)

HTH

[westconn1]

arrExcelValues = .Range("A1:A" & lRow).Value

'~~> Skip this line if the number of rows in B will the same
'~~> as rows in A

why not just use a single array of 2 columns?

[koolsid]

Yes, I thought of that. My only concern was that if the user was a newbie then he might get stuck on how to use a 2D array. My next step was to show him exactly that once the the above method worked for him

[jimmysheedah]

Hi koolsid and westconn1,

Firstly, thank you for the welcome.

A quick question; I am curious as to what this part of the code does; my assumption is that it will go down column A until the last row?
End(xlUp) does this have to be defined or is xlUp one up from the last row.

lRow = .Range("A" & .Rows.Count).End(xlUp).Row

I can see how a 2 column array could be used for referencing and efficiency. I suppose that would come handy later when I'm trying to make it all look more efficient.

This has been very helpful and I will try and implement it. I have an additonal query - if for example I am searching for one item e.g. "0001_0001" to insert an hyperlink "C:\0001_0001.PDF" is there anyway I could replace all item's found?
At the moment I just have all occurences saved in my excel.

[koolsid]

That part of the code checks for the last empty row. It checks from Down to Up. This is more effective in finding the last row in lieu of Up to Down. Up to Down fails if there are blank cells in between and hence should be avoided.

Yes you can do a Find and .FindNext OR use an Autofilter to loop though all visible cells that match the criteria if they are in the same column.