EXTRACT HYPERLINK IN EXCEL
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
USAGE :
=HyperLinkText(A1)