I am planning on implementing a new files server in the upcoming weeks. A few people that we support have excel spreadsheets that have multiple drives and file paths hyperlinks and I want to change those links into there UNC paths. Then this will allow me to then just replace the old server path with the new one. I am having trouble with an efficient macro to convert multiple drives and file path to the UNC path. I did try a find and replace macro but I still found myself entering each path in the find and replace macro and it does not seem efficient. Below is my macro and the paths are just examples. Also, its for Excel 2013.
Sub Multi_FindReplace()
Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
Dim hLink As Hyperlink
fndList = Array("Z:\Football", "Z:\Basketball", "S:\Baseball")
rplcList = Array("\\ed1\new\Football", "\\ed1\new\Basketball", "\\ed1\new\Baseball")
'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
Next x
For Each wSheet In Worksheets
For Each hLink In wSheet.Hyperlinks
hLink.Address = Replace(hLink.Address, "\\ed1\", "\\ed2\") 'Swap OldServer and NewServer to match name case sensitive
Next hLink
Next
For Each ws In Worksheets
ws.Cells.Replace What:="\\ed1\", Replacement:="\\ed2\", LookAt:=xlPart, MatchCase:=False 'Swap OldServer and NewServer to match name.
Next
End Sub
Sub Multi_FindReplace()
Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
Dim hLink As Hyperlink
fndList = Array("Z:\Football", "Z:\Basketball", "S:\Baseball")
rplcList = Array("\\ed1\new\Football", "\\ed1\new\Basketball", "\\ed1\new\Baseball")
'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
Next x
For Each wSheet In Worksheets
For Each hLink In wSheet.Hyperlinks
hLink.Address = Replace(hLink.Address, "\\ed1\", "\\ed2\") 'Swap OldServer and NewServer to match name case sensitive
Next hLink
Next
For Each ws In Worksheets
ws.Cells.Replace What:="\\ed1\", Replacement:="\\ed2\", LookAt:=xlPart, MatchCase:=False 'Swap OldServer and NewServer to match name.
Next
End Sub