Excel|2007|2003|Microsoft Excel|Formula|Function|Pivto Table|Excel Topics|Passwords|Hyperlink Excel Guru: Excel: Extract hyperlink address (files and web addresses) in Excel 2003/XP/2000/97

Tuesday, September 29, 2009

Excel: Extract hyperlink address (files and web addresses) in Excel 2003/XP/2000/97

Question: In Excel 2003/XP/2000/97, I have a spreadsheet that contains hyperlink addresses to files. I tried extracting the hyperlink address for these files, however I'm not getting the complete Address. The complete Address should be:

C:\My Documents\Past Projects\Centennial\Program Status Report.xls

But I only get:

\..\..\Past Projects\Centennial\Program Status Report.xls

Is there a way to always get the complete hyperlink address?



Answer: Below are two functions that you can include in your spreadsheet to extract the complete hyperlink address for either a file of a web address.

Function HyperLinkText(pRange As Range) As String

Dim ST1 As String
Dim ST2 As String
Dim LPath As String
Dim ST1Local As String
If pRange.Hyperlinks.Count = 0 Then
Exit Function
End If

LPath = ThisWorkbook.FullName
ST1 = pRange.Hyperlinks(1).Address
ST2 = pRange.Hyperlinks(1).SubAddress

If Mid(ST1, 1, 15) = "..\..\..\..\..\" Then
ST1Local = ReturnPath(LPath, 5) & Mid(ST1, 15)
ElseIf Mid(ST1, 1, 12) = "..\..\..\..\" Then
ST1Local = ReturnPath(LPath, 4) & Mid(ST1, 12)
ElseIf Mid(ST1, 1, 9) = "..\..\..\" Then
ST1Local = ReturnPath(LPath, 3) & Mid(ST1, 9)
ElseIf Mid(ST1, 1, 6) = "..\..\" Then
ST1Local = ReturnPath(LPath, 2) & Mid(ST1, 6)
ElseIf Mid(ST1, 1, 3) = "..\" Then
ST1Local = ReturnPath(LPath, 1) & Mid(ST1, 3)
Else
ST1Local = ST1
End If

If ST2 <> "" Then
ST1Local = "[" & ST1Local & "]" & ST2
End If

HyperLinkText = ST1Local

End Function

Function ReturnPath(pAppPath As String, pCount As Integer) As String

Dim LPos As Integer
Dim LTotal As Integer
Dim LLength As Integer

LTotal = 0
LLength = Len(pAppPath)

Do Until LTotal = pCount + 1
If Mid(pAppPath, LLength, 1) = "\" Then
LTotal = LTotal + 1
End If
LLength = LLength - 1
Loop

ReturnPath = Mid(pAppPath, 1, LLength)

End Function

Then you can reference these new functions in your spreadsheet.

For example in cell B1, you could enter the following:

=HyperLinkText(A1)



0 comments:

Post a Comment