Find and replace portions of hyperlink path

[LackLuster63]

Hello - I need to move a folder containing test reports to a new server location. There is a spreadsheet with hyperlinks to the test reports that will be broken when the folder is moved. I'd like to swap out the old folder location with a new one for each of the links in the spreadsheet. For example:

Old file path

https://co.sharepoint.com/?️/t/Loc/taiwan/

EVrD23mkqjtNoAgekM2CVJ4BeVZFYbjp0h5TdENOLOY35A?e=vbqYwT

New file path

https://co.sharepoint.com/?️/t/RandD/

EVrD23mkqjtNoAgekM2CVJ4BeVZFYbjp0h5TdENOLOY35A?e=vbqYwT

An older post featured a similar question with the following code as a solution, but I wasn't able to make it work for my application:

Find and replace portions of hyperlinks​

• Thread starterwillow1985
• Start dateFeb 17, 2021

Sub AlterHyperlinks()
Dim c As Range
Dim pos As Long
Dim tmp As String

Const sNewPath As String = "\\DAVINCI-1\COMMON\MSDS Database"

For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
If c.Hyperlinks.Count > 0 Then
tmp = c.Hyperlinks(1).Address
pos = InStrRev(tmp, "\", InStrRev(tmp, "\") - 1)
If pos > 0 Then c.Hyperlinks(1).Address = sNewPath & Mid(tmp, pos)
End If
Next c
End Sub

 

[John_w]

As I see it, you want to change the "/Loc/taiwan/" part of each hyperlink to "/RandD/".

Public Sub Change_Hyperlinks()

    Dim ws As Worksheet
    Dim hlink As Hyperlink
    
    For Each ws In ActiveWorkbook.Worksheets
        For Each hlink In ws.Hyperlinks
            hlink.Address = Replace(hlink.Address, "/Loc/taiwan/", "/RandD/", Compare:=vbTextCompare)
        Next
    Next
        
End Sub

 

[LackLuster63]

Thank you - that works. I think I had this over-complicated in my mind. I appreciate your help!