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 = ST1LocalEnd Function
Function ReturnPath(pAppPath As String, pCount As Integer) As String
Dim LPos As Integer
Dim LTotal As Integer
Dim LLength As IntegerLTotal = 0
LLength = Len(pAppPath)Do Until LTotal = pCount + 1
If Mid(pAppPath, LLength, 1) = "\" Then
LTotal = LTotal + 1
End If
LLength = LLength - 1
LoopReturnPath = 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