Изменение гиперссылок макросом

Вырубился ноут с включенным экселем, после открытия автосохраненного файла на нем слетели адреса гиперссылок.
Пробовал следующий макрос, эффекта 0 (ссылки на этот путь)

Sub ZamenaIsporchennihGiperssilok()
On Error Resume Next
Dim hl As Hyperlink, oldString As String, newString As String, sh As Worksheet
' part of hyperlink, which you want to change
oldString = "C:\Users\User\AppData\Roaming\Microsoft\Excel\"
' to what to change
newString = ""
For Each sh In ActiveWorkbook.Worksheets
For Each hl In sh.Hyperlinks
If hl.Address Like "*" & oldString & "*" Then
hl.Address = Replace(hl.Address, oldString, newString)
End If
Next
Next sh

Ссылок много, вручную править желания меньше, чем выкинуть бук в окно.

Дополнен

П. С. - гиперссылки на листы файлов в одной папке

По дате

По Рейтингу

user_723893

Новичок

9лет

Попробуйте так

Sub ReplaceLinks()
Dim objSheet As Worksheet
Dim objHL As Hyperlink
Dim strNewLink As String
Dim intPos As Integer

Set objSheet = ThisWorkbook.Sheets(1) 'Здесь либо номер листа, где ссылки, либо в кавычках имя

For Each objHL In objSheet.Hyperlinks
If InStr(1, objHL.Address, "C:\Users\User\AppData\Roaming") Then
intPos = InStrRev(objHL.Address, "\")
If intPos > 0 Then
strNewLink = Mid(objHL.Address, intPos + 1)
objHL.Address = strNewLink
objHL.TextToDisplay = strNewLink
End If
End If
Next
End Sub

Ток сделайте резервную копию на всякий ;)
Ищет ссылки на C:\....\ , находит последний \, отрезает "путь", оставляя имя файла и т. п.

Если не получится - пишите в комментах - разберемся. У меня пашет.