Для того, чтобы перебрать все гиперссылки, расположенные в столбце «A» активного рабочего листа и получить абсолютный путь из относительного, можно воспользоваться нижеприведённым макросом. Обратите внимание на то, что лист, диапазон (столбец), а также функция MsgBox используются исключительно в качестве примера.
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
Используемые в данном макросе функции WinAPI не проверяют ни корректность адреса гиперссылки, ни наличие файлов (папок), так что будьте внимательны.