sspatriots
Well-known Member
- Joined
- Nov 22, 2011
- Messages
- 585
- Office Version
- 365
- Platform
- Windows
Hi,
I've had some success with various versions of the code below to fix hyperlinks that somehow get changed by a user. Not sure if they are saving the file to their hard drive and then back to the server to cause this or not. Regardless, I need a way to get this back to the way it was and my code doesn't seem to work. Not sure if I have a missing forward slash or backslash or what or maybe I have them backwards.
Here is what I have tried:
I've had some success with various versions of the code below to fix hyperlinks that somehow get changed by a user. Not sure if they are saving the file to their hard drive and then back to the server to cause this or not. Regardless, I need a way to get this back to the way it was and my code doesn't seem to work. Not sure if I have a missing forward slash or backslash or what or maybe I have them backwards.
Here is what I have tried:
VBA Code:
Sub FixPOHyperlinksHH()
Dim wb As Workbook
Dim ws As Worksheet
Dim tb As ListObject
Dim OldStr As String, NewStr As String
Dim hyp As Hyperlink
Set wb = ThisWorkbook
Set ws = wb.ActiveSheet 'Sheets("2023")
' assumes Table is the first one on the ActiveSheet
Set tb = ActiveSheet.ListObjects(1)
ws.Activate
OldStr = "C:\Users\HHenderson\AppData\Roaming\Microsoft"
NewStr = "G:\DEManufacturing"
For Each hyp In tb.ListColumns("PO#").DataBodyRange.Hyperlinks
If InStr(1, hyp.Address, "/") > 0 Then
hyp.Address = Replace(hyp.Address, OldStr, NewStr)
Else
hyp.Address = NewStr & "/" & hyp.Address
End If
Next hyp
End Sub