Hyperlink find and replace?

[John]

A client has an excel spreadsheet they've got hyperlinks on. They use the
links to link to JPG pictures on a file server on their network. There's
about 650 or so of these links, all were put in manually as this file grew
(parts list).

They have since moved their data to a new server, and thus the path needs to
change (\\server1\blahblah to \\server2\blahblah).

Is there any easy way to do a find and replace for *part* of a hyperlink? I
would assume it's an all or nothing proposition?

I found the file / properties / summary / hyperbase link option, but I don't
see how that would help since the wrong path is already in all the links?

Thanks for any suggestions

 

[Dave Peterson]

Take a look at David McRitchie's site:
http://www.mvps.org/dmcritchie/excel/buildtoc.htm
look for:
Fix Hyperlinks (#FixHyperlinks)

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

 

[John]

Looks very promising! Thanks very much for the quick reply!

J

 

[Guest]

Here's one way. I haven't gotten to where I need it yet, so it's not tested
fully.

Sub FixHyperlinkPaths()

' ----------------------------------------------------------
' ********** !!! NOT TESTED YET !!! ***********
' ----------------------------------------------------------
' replaces hyperlink paths with the name of the worksheet tab
' eg., if the hyperlink is : I:\CIS SYS TECH REF\DOC\D220\ACTVAFFG.txt
' and the sheet tab is D213, the new hyperlink would be
' D213/ACTVAFFG.txt
' Note that the rest of the address will be stored in the hyperlink
base -
' which is set in File/Properties/Summary

Dim ThisHyperlink As Hyperlink
Dim ThisHyperlinkAddress As String
Dim CharPos As Long
Dim ThisChar As String
Dim NewHyperlinkAddress As String


For Each ThisHyperlink In ActiveSheet.Hyperlinks
ThisHyperlinkAddress = ThisHyperlink.Address
' MsgBox "hyperlink=" & ThisHyperlinkAddress
For CharPos = Len(ThisHyperlinkAddress) To 1 Step -1
ThisChar = Mid(ThisHyperlinkAddress, CharPos, 1)
If ThisChar = "/" Or ThisChar = "\" Then
NewHyperlinkAddress = UCase(ActiveSheet.Name) & _
"/" & Right(ThisHyperlinkAddress,
Len(ThisHyperlinkAddress) - CharPos)
' MsgBox "new hyperlink=" & NewHyperlinkAddress
ThisHyperlink.Address = NewHyperlinkAddress
End If
Next
Exit For
Next

End Sub
==========================================
After I wrote the previous macro, I was researching another problem, and
found a way to extract a file name w/o doing the reverse search for the path
separator ("/" or "\"). This is a macro I wrote to try out various things,
with comments added to display the results of the statements. I plan to
replace part of the previous macro with the GetFileName function.

Sub TryItOut2()

Dim Fs
Dim HoldFileName As String


Set Fs = CreateObject("Scripting.FileSystemObject")
' MsgBox "type=" & TypeName(Fs) ' displays : FileSystemObject
' ' Fs = "d220/fsaml900.txt"
' ' MsgBox "fs=" & Fs
' MsgBox "basename=" & Fs.GetBaseName("d220/fsaml910.txt") ' displays :
fsaml910
' MsgBox "filename=" & Fs.GetFileName("d220/fsaml910.txt") ' displays :
fsaml910.txt
' MsgBox "buildpath=" & Fs.BuildPath("d220", "fsaml910.txt") ' displays :
d220\fsaml910.txt

' MsgBox "misc.txt=" & Fs.FileExists("c:shannon/misc.txt") ' displays
False
' MsgBox "c:/misc.txt=" & Fs.FileExists("c:/shannon/misc.txt") ' displays
True
' MsgBox "txt=" & Fs.FileExists("I:\CIS SYS TECH
REF\DOC\D220\FSBR001E.txt") ' displays : True
' MsgBox "doc=" & Fs.FileExists("I:\CIS SYS TECH
REF\DOC\D220\FSBR001E.doc") ' displays : False
If Fs.FileExists("c:/shannon/misc.txt") Then
MsgBox "if true" ' this displays
Else
MsgBox "if false"
End If

End Sub
===========================================