Extract Hyperlink in Excel

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)