Private Declare Function PathIsRelative _
        Lib "shlwapi.dll" Alias "PathIsRelativeA" ( _
        ByVal pszPath As String) As Long
Private Declare Function GetFullPathName _
        Lib "kernel32.dll" Alias "GetFullPathNameA" ( _
        ByVal lpFileName As String, _
        ByVal nBufferLength As Long, _
        ByVal lpBuffer As String, _
        ByVal lpFilePart As String) As Long
 
Private Sub getAbsoluteHyperlink()
    Dim iHyperlink As Hyperlink
    Dim iPath$, iAddress$, iAbsoluteName$
 
    iPath = ThisWorkbook.BuiltinDocumentProperties("Hyperlink Base")
    If iPath = "" Then ThisWorkbook.Path
    If Not iPath Like "*\" Then iPath = iPath & "\"
 
    For Each iHyperlink In Range("A:A").Hyperlinks
        iAddress = iHyperlink.Address
        If CBool(PathIsRelative(iAddress)) = True Then
           iAbsoluteName = Space(255)
           GetFullPathName _
           iPath & iAddress, 255&, iAbsoluteName, vbNullString
           iAbsoluteName = RTrim(iAbsoluteName)
           'iAbsoluteName = Application.Clean(iAbsoluteName)

           MsgBox _
           "Относительная = " & iAddress & vbCr & _
           "Абсолютная = " & iAbsoluteName, , iHyperlink.Range.Address
        Else
           MsgBox "Абсолютная = " & iAddress, , iHyperlink.Range.Address
        End If
    Next
End Sub

Private Sub getAbsoluteHyperlink2()
    Dim iSource As Range, iHyperlink As Hyperlink
    Dim iPath$, iAddress$, iAbsoluteName$, iLength&
 
    iPath = ThisWorkbook.BuiltinDocumentProperties("Hyperlink Base")
    If iPath <> "" Then
       If Right(iPath, 1) <> "\" Then iPath = iPath & "\"
    Else
       iPath = ThisWorkbook.Path & "\"
    End If
    Set iSource = ThisProject.Лист1.Columns(1)
 
    For Each iHyperlink In iSource.Hyperlinks
        iAddress = iHyperlink.Address
        If PathIsRelative(iAddress) = 1 Then
           iAbsoluteName = Space(255)
           iLength = GetFullPathName( _
           iPath & iAddress, 255&, iAbsoluteName, vbNullString)
           iAbsoluteName = Left(iAbsoluteName, iLength)
 
           MsgBox _
           "Относительная = " & iAddress & vbCr & _
           "Абсолютная = " & iAbsoluteName, , ""
        Else
           MsgBox "Абсолютная = " & iAddress, , ""
        End If
    Next
End Sub