Changing lots of Excel hyperlinks at once - nearly got it working

[henryJT]

I need to change a lot of hyperlinks in a spreadsheet, as users where saving to their shared drive instead of a central location.
I have this code, which is nearly working...

Public Sub ChangeHyperlinks()
Dim ws As Worksheet
Dim hlink As Hyperlink
Dim p As Long
For Each ws In ActiveWorkbook.Worksheets
For Each hlink In ws.Hyperlinks
p = InStrRev(hlink.Address, "\\fileserver\profiles\LMM\Desktop")
If p > 0 Then
hlink.Address = "\\fileserver\documents\link files" & Mid(hlink.Address, p + 1)
End If
Next
Next
End Sub

However, what is happening when I run it, it's putting the new path in, then adding the old path afterwards, I want the old path removed and just the filename adding to the new. Is that easy to do?

 

[shknbk2]

In your case, the result from InStrRev was no different than InStr. Both would give the value of 1 if that path was in the hyperlink. That might have been confusing you with what you were expecting for the value of p. p isn't the count where the old hyperlink ended, it is where it started. InStrRev finds the beginning location of where the search string occurs searching right to left. Since the hyperlink path only occurs once, when found, it will be at the beginning of the hyperlink address; thus p = 1.

Try this replacement:

Public Sub ChangeHyperlinks()
    Dim ws As Worksheet
    Dim hlink As Hyperlink
    Dim p As Long
    For Each ws In ActiveWorkbook.Worksheets
        For Each hlink In ws.Hyperlinks
            p = InStrRev(hlink.Address, "\\fileserver\profiles\LMM\Desktop")
            If p > 0 Then
                hlink.Address = "\\fileserver\documents\link files" & Mid(hlink.Address, Len("\\fileserver\profiles\LMM\Desktop") + 1)
            End If
        Next
    Next
End Sub