Updating Hyperlinks with VBA
 

Hi,

Completely new to VBA in Excel. I've got a large number of excel files
(approx 600) all which contain up to 20 hyperlinks to drawings and other
files contained on a workgrouped computer. Due to the computer crashing we
have had to move all these drawings to another computer and i need to find a
way to update what is potentially 12,000 hyperlinks. (i'm aware that the
setup of these computers is by no means ideal)

Anyway i've tried to copy some vba off the microsoft site with no luck as
yet. If anyone can find the error or has a better solution please let me know.

Code below: (http://support.microsoft.com/default...b;en-us;247507)

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink

' These can be any text portion of a hyperlink, such as ".com" or ".org".
oldtext = "/Matt"
newtext = "/Bob"

' Check all hyperlinks on active sheet.
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next
End Sub

Cheers

Updating Hyperlinks with VBA
 

Hi

Please beware that the

h.TextToDisplay might be different from h.Address

The h.Address always come with the "/" as ended, e.g. http://www.msn.com/
However the Text to display might doesn't come with the "/" e.g.
http://www.msn.com

so the display result won't change.

hope this help.

Leung
HK



"fordrules01" wrote:

Hi,

Completely new to VBA in Excel. I've got a large number of excel files
(approx 600) all which contain up to 20 hyperlinks to drawings and other
files contained on a workgrouped computer. Due to the computer crashing we
have had to move all these drawings to another computer and i need to find a
way to update what is potentially 12,000 hyperlinks. (i'm aware that the
setup of these computers is by no means ideal)

Anyway i've tried to copy some vba off the microsoft site with no luck as
yet. If anyone can find the error or has a better solution please let me know.

Code below: (http://support.microsoft.com/default...b;en-us;247507)

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink

' These can be any text portion of a hyperlink, such as ".com" or ".org".
oldtext = "/Matt"
newtext = "/Bob"

' Check all hyperlinks on active sheet.
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next
End Sub

Cheers

Updating Hyperlinks with VBA
 

Yes I have noted this but its still does not seem to change anything.

What i am trying to achieve is to replace a hyperlink that says:
c:\Matt\Documents and settings\example_file.xls
to
C:\Bob\Documents and settings\example_file.xls

Is what i had in the code suitable for this?



"Leung" wrote:

Hi

Please beware that the

h.TextToDisplay might be different from h.Address

The h.Address always come with the "/" as ended, e.g. http://www.msn.com/
However the Text to display might doesn't come with the "/" e.g.
http://www.msn.com

so the display result won't change.

hope this help.

Leung
HK



"fordrules01" wrote:

Hi,

Completely new to VBA in Excel. I've got a large number of excel files
(approx 600) all which contain up to 20 hyperlinks to drawings and other
files contained on a workgrouped computer. Due to the computer crashing we
have had to move all these drawings to another computer and i need to find a
way to update what is potentially 12,000 hyperlinks. (i'm aware that the
setup of these computers is by no means ideal)

Anyway i've tried to copy some vba off the microsoft site with no luck as
yet. If anyone can find the error or has a better solution please let me know.

Code below: (http://support.microsoft.com/default...b;en-us;247507)

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink

' These can be any text portion of a hyperlink, such as ".com" or ".org".
oldtext = "/Matt"
newtext = "/Bob"

' Check all hyperlinks on active sheet.
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next
End Sub

Cheers

Updating Hyperlinks with VBA
 

There might be some chance that local address will be converted as below as
relative path:

.../../../../Matt/Documents and settings/example_file.xls

so, i suggest you try "/bob/"

hope this work.





"fordrules01" wrote:

Yes I have noted this but its still does not seem to change anything.

What i am trying to achieve is to replace a hyperlink that says:
c:\Matt\Documents and settings\example_file.xls
to
C:\Bob\Documents and settings\example_file.xls

Is what i had in the code suitable for this?



"Leung" wrote:

Hi

Please beware that the

h.TextToDisplay might be different from h.Address

The h.Address always come with the "/" as ended, e.g. http://www.msn.com/
However the Text to display might doesn't come with the "/" e.g.
http://www.msn.com

so the display result won't change.

hope this help.

Leung
HK



"fordrules01" wrote:

Hi,

Completely new to VBA in Excel. I've got a large number of excel files
(approx 600) all which contain up to 20 hyperlinks to drawings and other
files contained on a workgrouped computer. Due to the computer crashing we
have had to move all these drawings to another computer and i need to find a
way to update what is potentially 12,000 hyperlinks. (i'm aware that the
setup of these computers is by no means ideal)

Anyway i've tried to copy some vba off the microsoft site with no luck as
yet. If anyone can find the error or has a better solution please let me know.

Code below: (http://support.microsoft.com/default...b;en-us;247507)

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink

' These can be any text portion of a hyperlink, such as ".com" or ".org".
oldtext = "/Matt"
newtext = "/Bob"

' Check all hyperlinks on active sheet.
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next
End Sub

Cheers

Updating Hyperlinks with VBA
 

One thing that could cause trouble is that
application.worksheetfunction.substitute is case sensitive.

So if your links actually contained /matt or /MaTt, then the code would not work
as expected.

If you're using xl2k or higher, you could use Replace instead of
application.worksheetfunction.substitute.

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

========
If this doesn't help, you may want to post back with samples (directly copied
from the insert hyperlink dialog) and pasted into your message.



fordrules01 wrote:

Hi,

Completely new to VBA in Excel. I've got a large number of excel files
(approx 600) all which contain up to 20 hyperlinks to drawings and other
files contained on a workgrouped computer. Due to the computer crashing we
have had to move all these drawings to another computer and i need to find a
way to update what is potentially 12,000 hyperlinks. (i'm aware that the
setup of these computers is by no means ideal)

Anyway i've tried to copy some vba off the microsoft site with no luck as
yet. If anyone can find the error or has a better solution please let me know.

Code below: (http://support.microsoft.com/default...b;en-us;247507)

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink

' These can be any text portion of a hyperlink, such as ".com" or ".org".
oldtext = "/Matt"
newtext = "/Bob"

' Check all hyperlinks on active sheet.
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next
End Sub

Cheers

--

Dave Peterson

Updating Hyperlinks with VBA
 

Dave,

I had a look through the link you mentioned and have found some code that i
need help to modify slightly. The code is from Dick Kusleika's post
http://groups.google.com/group/micro...7ae7cd9cf83f34

Unfortunately its from 2002 so i don't fancy my chances of getting a reply
in there. What i want to achieve is to modify the hyperlinks after they have
been identified in this code below.

Sub FindHlinks()


Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim i As Integer


'Change this path to where the workbooks are
MyPath = "C:\Dick\Tester\Test2\"
i = 1


'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")


'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'See if the name of your backup directory is in
'the hlink address. I searched for NewTest, but
'you will want to search for the name of your
'own backup directory
If InStr(HL.Address, "NewTest") 0 Then
With ThisWorkbook.Sheets(1)
'Write the info to cells
.Cells(i, 1) = CurrWb.Name
.Cells(i, 2) = sh.Name
.Cells(i, 3) = HL.Address
.Cells(i, 4) = HL.Range.Address
End With
i = i + 1
End If
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop


Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing


End Sub

Better yet, if someone can also tell me how to make have it allow a user to
input the path of the folder before it runs that would be ideal.

Cheers.

Matt




"Dave Peterson" wrote:

One thing that could cause trouble is that
application.worksheetfunction.substitute is case sensitive.

So if your links actually contained /matt or /MaTt, then the code would not work
as expected.

If you're using xl2k or higher, you could use Replace instead of
application.worksheetfunction.substitute.

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

========
If this doesn't help, you may want to post back with samples (directly copied
from the insert hyperlink dialog) and pasted into your message.



fordrules01 wrote:

Hi,

Completely new to VBA in Excel. I've got a large number of excel files
(approx 600) all which contain up to 20 hyperlinks to drawings and other
files contained on a workgrouped computer. Due to the computer crashing we
have had to move all these drawings to another computer and i need to find a
way to update what is potentially 12,000 hyperlinks. (i'm aware that the
setup of these computers is by no means ideal)

Anyway i've tried to copy some vba off the microsoft site with no luck as
yet. If anyone can find the error or has a better solution please let me know.

Code below: (http://support.microsoft.com/default...b;en-us;247507)

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink

' These can be any text portion of a hyperlink, such as ".com" or ".org".
oldtext = "/Matt"
newtext = "/Bob"

' Check all hyperlinks on active sheet.
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next
End Sub

Cheers

--

Dave Peterson

Updating Hyperlinks with VBA
 

I don't understand why you want a report--why not just update the
hyperlinks?????

fordrules01 wrote:

Dave,

I had a look through the link you mentioned and have found some code that i
need help to modify slightly. The code is from Dick Kusleika's post
http://groups.google.com/group/micro...7ae7cd9cf83f34

Unfortunately its from 2002 so i don't fancy my chances of getting a reply
in there. What i want to achieve is to modify the hyperlinks after they have
been identified in this code below.

Sub FindHlinks()

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim i As Integer

'Change this path to where the workbooks are
MyPath = "C:\Dick\Tester\Test2\"
i = 1

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")

'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'See if the name of your backup directory is in
'the hlink address. I searched for NewTest, but
'you will want to search for the name of your
'own backup directory
If InStr(HL.Address, "NewTest") 0 Then
With ThisWorkbook.Sheets(1)
'Write the info to cells
.Cells(i, 1) = CurrWb.Name
.Cells(i, 2) = sh.Name
.Cells(i, 3) = HL.Address
.Cells(i, 4) = HL.Range.Address
End With
i = i + 1
End If
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop

Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing

End Sub

Better yet, if someone can also tell me how to make have it allow a user to
input the path of the folder before it runs that would be ideal.

Cheers.

Matt

"Dave Peterson" wrote:

One thing that could cause trouble is that
application.worksheetfunction.substitute is case sensitive.

So if your links actually contained /matt or /MaTt, then the code would not work
as expected.

If you're using xl2k or higher, you could use Replace instead of
application.worksheetfunction.substitute.

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

========
If this doesn't help, you may want to post back with samples (directly copied
from the insert hyperlink dialog) and pasted into your message.



fordrules01 wrote:

Hi,

Completely new to VBA in Excel. I've got a large number of excel files
(approx 600) all which contain up to 20 hyperlinks to drawings and other
files contained on a workgrouped computer. Due to the computer crashing we
have had to move all these drawings to another computer and i need to find a
way to update what is potentially 12,000 hyperlinks. (i'm aware that the
setup of these computers is by no means ideal)

Anyway i've tried to copy some vba off the microsoft site with no luck as
yet. If anyone can find the error or has a better solution please let me know.

Code below: (http://support.microsoft.com/default...b;en-us;247507)

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink

' These can be any text portion of a hyperlink, such as ".com" or ".org".
oldtext = "/Matt"
newtext = "/Bob"

' Check all hyperlinks on active sheet.
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next
End Sub

Cheers

--

Dave Peterson


--

Dave Peterson

Updating Hyperlinks with VBA
 

Dave,

I don't want to report. I do just want to update. Where i liked this code
was that it allowed me to use all the .xls files in a whole directory rather
than individual workbooks. I want to modify it so it does just automatically
update. The reporting of what has been updated may be beneficial but is a
secondary consideration.

Cheers,

Matt

"Dave Peterson" wrote:

I don't understand why you want a report--why not just update the
hyperlinks?????

fordrules01 wrote:

Dave,

I had a look through the link you mentioned and have found some code that i
need help to modify slightly. The code is from Dick Kusleika's post
http://groups.google.com/group/micro...7ae7cd9cf83f34

Unfortunately its from 2002 so i don't fancy my chances of getting a reply
in there. What i want to achieve is to modify the hyperlinks after they have
been identified in this code below.

Sub FindHlinks()

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim i As Integer

'Change this path to where the workbooks are
MyPath = "C:\Dick\Tester\Test2\"
i = 1

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")

'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'See if the name of your backup directory is in
'the hlink address. I searched for NewTest, but
'you will want to search for the name of your
'own backup directory
If InStr(HL.Address, "NewTest") 0 Then
With ThisWorkbook.Sheets(1)
'Write the info to cells
.Cells(i, 1) = CurrWb.Name
.Cells(i, 2) = sh.Name
.Cells(i, 3) = HL.Address
.Cells(i, 4) = HL.Range.Address
End With
i = i + 1
End If
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop

Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing

End Sub

Better yet, if someone can also tell me how to make have it allow a user to
input the path of the folder before it runs that would be ideal.

Cheers.

Matt

"Dave Peterson" wrote:

One thing that could cause trouble is that
application.worksheetfunction.substitute is case sensitive.

So if your links actually contained /matt or /MaTt, then the code would not work
as expected.

If you're using xl2k or higher, you could use Replace instead of
application.worksheetfunction.substitute.

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

========
If this doesn't help, you may want to post back with samples (directly copied
from the insert hyperlink dialog) and pasted into your message.



fordrules01 wrote:

Hi,

Completely new to VBA in Excel. I've got a large number of excel files
(approx 600) all which contain up to 20 hyperlinks to drawings and other
files contained on a workgrouped computer. Due to the computer crashing we
have had to move all these drawings to another computer and i need to find a
way to update what is potentially 12,000 hyperlinks. (i'm aware that the
setup of these computers is by no means ideal)

Anyway i've tried to copy some vba off the microsoft site with no luck as
yet. If anyone can find the error or has a better solution please let me know.

Code below: (http://support.microsoft.com/default...b;en-us;247507)

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink

' These can be any text portion of a hyperlink, such as ".com" or ".org".
oldtext = "/Matt"
newtext = "/Bob"

' Check all hyperlinks on active sheet.
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next
End Sub

Cheers

--

Dave Peterson


--

Dave Peterson

Updating Hyperlinks with VBA
 

I would spend some time getting the macro that fixed one worksheet's hyperlinks
working. Then advance to multiple sheets, then multiple workbooks.

But maybe you can modify this:

Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim DestCell As Range
Dim RngToCopy As Range

Dim OldStr As String
Dim NewStr As String
Dim hyp As Hyperlink

OldStr = "http://192.168.15.5/"
NewStr = "http://hank.home.on.ca/"

Application.ScreenUpdating = False

'change the folder here
myPath = "C:\my documents\excel\test"
If myPath = "" Then Exit Sub
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
Application.StatusBar _
= "Processing: " & myNames(fCtr) & " at: " & Now
Set wkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

For Each wks In wkbk.Worksheets
For Each hyp In ActiveSheet.Hyperlinks
hyp.Address = Replace(hyp.Address, OldStr, NewStr)
Next hyp
Next wks

wkbk.Close savechanges:=True

Next fCtr
End If

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

fordrules01 wrote:

Dave,

I don't want to report. I do just want to update. Where i liked this code
was that it allowed me to use all the .xls files in a whole directory rather
than individual workbooks. I want to modify it so it does just automatically
update. The reporting of what has been updated may be beneficial but is a
secondary consideration.

Cheers,

Matt

"Dave Peterson" wrote:

I don't understand why you want a report--why not just update the
hyperlinks?????

fordrules01 wrote:

Dave,

I had a look through the link you mentioned and have found some code that i
need help to modify slightly. The code is from Dick Kusleika's post
http://groups.google.com/group/micro...7ae7cd9cf83f34

Unfortunately its from 2002 so i don't fancy my chances of getting a reply
in there. What i want to achieve is to modify the hyperlinks after they have
been identified in this code below.

Sub FindHlinks()

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim i As Integer

'Change this path to where the workbooks are
MyPath = "C:\Dick\Tester\Test2\"
i = 1

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")

'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'See if the name of your backup directory is in
'the hlink address. I searched for NewTest, but
'you will want to search for the name of your
'own backup directory
If InStr(HL.Address, "NewTest") 0 Then
With ThisWorkbook.Sheets(1)
'Write the info to cells
.Cells(i, 1) = CurrWb.Name
.Cells(i, 2) = sh.Name
.Cells(i, 3) = HL.Address
.Cells(i, 4) = HL.Range.Address
End With
i = i + 1
End If
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop

Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing

End Sub

Better yet, if someone can also tell me how to make have it allow a user to
input the path of the folder before it runs that would be ideal.

Cheers.

Matt

"Dave Peterson" wrote:

One thing that could cause trouble is that
application.worksheetfunction.substitute is case sensitive.

So if your links actually contained /matt or /MaTt, then the code would not work
as expected.

If you're using xl2k or higher, you could use Replace instead of
application.worksheetfunction.substitute.

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

========
If this doesn't help, you may want to post back with samples (directly copied
from the insert hyperlink dialog) and pasted into your message.



fordrules01 wrote:

Hi,

Completely new to VBA in Excel. I've got a large number of excel files
(approx 600) all which contain up to 20 hyperlinks to drawings and other
files contained on a workgrouped computer. Due to the computer crashing we
have had to move all these drawings to another computer and i need to find a
way to update what is potentially 12,000 hyperlinks. (i'm aware that the
setup of these computers is by no means ideal)

Anyway i've tried to copy some vba off the microsoft site with no luck as
yet. If anyone can find the error or has a better solution please let me know.

Code below: (http://support.microsoft.com/default...b;en-us;247507)

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink

' These can be any text portion of a hyperlink, such as ".com" or ".org".
oldtext = "/Matt"
newtext = "/Bob"

' Check all hyperlinks on active sheet.
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next
End Sub

Cheers

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson

Updating Hyperlinks with VBA
 

Hi

I have created 3 Sub as below, just copy and paste to module section.
Input cells A1, A2 and A3, see below instruction.
Call the DoAll() or call it individually.

regards

Leung


==code start ==

'Three Steps:
Sub DoAll()

'please make sure A1, A2 and A3 is not empty

'Step 1 - list all hyperlink for all excels from path in cell A3 e.g.
"C:\test\"
Call FindHlinks

'Step 2 - list of hyperlink to be change from cell A1 to A2
'A1 "../abc/", "http://msn.com"
'A2 "../bcd/", "http://www.msn.com/"

Call CreateHyperlinkList

'Step 3 - Replace all
Call ReplaceAllHyperlink

End Sub



'==
'Discover all hyperlinks in a folder of spreadsheets
Sub FindHlinks()

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim i As Integer


strLookForPath = Range("A1").Value
strReplaceForPath = Range("A2").Value
MyPath = Range("A3").Value


'row to start to write down hyperlink information
i = 5

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")


'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'See if the name of your backup directory is in
'the hlink address. I searched for NewTest, but
'you will want to search for the name of your
'own backup directory
'+Previous If InStr(HL.Address, "NewTest") 0 Then
If InStr(HL.Address, strLookForPath) 0 Then
' With ThisWorkbook.Sheets(1)
' +added write to current sheet
With Workbooks("change_link.xls").Sheets(1)
'Write the info to cells
.Cells(i, 1) = CurrWb.Name
.Cells(i, 2) = sh.Name
.Cells(i, 3) = HL.Address
.Cells(i, 4) = HL.Range.Address
End With
i = i + 1
End If
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop


Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing

End Sub

' This copy and paste the col C into Col D with string replacement
' from Cell a1 to a2
Sub CreateHyperlinkList()

Dim strLookForPath As String
Dim strReplaceForPath As String

strLookForPath = Range("A1")
strReplaceForPath = Range("A2")


'existing link should start with cell C5
'copy all hyperlinks
Range("C5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'put it starting from cell E5
Range("E5").Select
ActiveSheet.Paste

Selection.Replace What:=strLookForPath,
Replacement:=strReplaceForPath, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

Range("E5").Select
Application.CutCopyMode = False


End Sub


'Perform this to replace all hyperlink
'remember to change the path

Sub ReplaceAllHyperlink()

'select range and it should start with A5
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

Dim strPara() As String
Dim i As Long

i = 1

Do While i <= Selection.Rows.Count
'do it one by one


'++change this
strMyPath = Range("A3").Value

Call ReplaceSingleHyperlink(strMyPath, _
Selection.Cells(i, 1).Value, _
Selection.Cells(i, 2).Value, _
Selection.Cells(i, 4).Value, _
Selection.Cells(i, 5).Value)
i = i + 1

Loop

End Sub


'this make the procedure more generic and reusable
Sub ReplaceSingleHyperlink(ByVal strMyPath As String, _
ByVal strWorkBookName As String, _
ByVal strSheetname As String, _
ByVal strAddress As String, _
ByVal strNewLink As String)

'no need to blinking
Application.ScreenUpdating = False

'replace one by one
Workbooks.Open (strMyPath & strWorkBookName)

ActiveWorkbook.Sheets(strSheetname).Range(strAddre ss).Hyperlinks(1).Address =
strNewLink
ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub


==code end ==






"Dave Peterson" wrote:

I would spend some time getting the macro that fixed one worksheet's hyperlinks
working. Then advance to multiple sheets, then multiple workbooks.

But maybe you can modify this:

Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim DestCell As Range
Dim RngToCopy As Range

Dim OldStr As String
Dim NewStr As String
Dim hyp As Hyperlink

OldStr = "http://192.168.15.5/"
NewStr = "http://hank.home.on.ca/"

Application.ScreenUpdating = False

'change the folder here
myPath = "C:\my documents\excel\test"
If myPath = "" Then Exit Sub
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
Application.StatusBar _
= "Processing: " & myNames(fCtr) & " at: " & Now
Set wkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

For Each wks In wkbk.Worksheets
For Each hyp In ActiveSheet.Hyperlinks
hyp.Address = Replace(hyp.Address, OldStr, NewStr)
Next hyp
Next wks

wkbk.Close savechanges:=True

Next fCtr
End If

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

fordrules01 wrote:

Dave,

I don't want to report. I do just want to update. Where i liked this code
was that it allowed me to use all the .xls files in a whole directory rather
than individual workbooks. I want to modify it so it does just automatically
update. The reporting of what has been updated may be beneficial but is a
secondary consideration.

Cheers,

Matt

"Dave Peterson" wrote:

I don't understand why you want a report--why not just update the
hyperlinks?????

fordrules01 wrote:

Dave,

I had a look through the link you mentioned and have found some code that i
need help to modify slightly. The code is from Dick Kusleika's post
http://groups.google.com/group/micro...7ae7cd9cf83f34

Unfortunately its from 2002 so i don't fancy my chances of getting a reply
in there. What i want to achieve is to modify the hyperlinks after they have
been identified in this code below.

Sub FindHlinks()

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim i As Integer

'Change this path to where the workbooks are
MyPath = "C:\Dick\Tester\Test2\"
i = 1

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")

'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'See if the name of your backup directory is in
'the hlink address. I searched for NewTest, but
'you will want to search for the name of your
'own backup directory
If InStr(HL.Address, "NewTest") 0 Then
With ThisWorkbook.Sheets(1)
'Write the info to cells
.Cells(i, 1) = CurrWb.Name
.Cells(i, 2) = sh.Name
.Cells(i, 3) = HL.Address
.Cells(i, 4) = HL.Range.Address
End With
i = i + 1
End If
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop

Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing

End Sub

Better yet, if someone can also tell me how to make have it allow a user to
input the path of the folder before it runs that would be ideal.

Cheers.

Matt

"Dave Peterson" wrote:

One thing that could cause trouble is that
application.worksheetfunction.substitute is case sensitive.

So if your links actually contained /matt or /MaTt, then the code would not work
as expected.

If you're using xl2k or higher, you could use Replace instead of
application.worksheetfunction.substitute.

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

========
If this doesn't help, you may want to post back with samples (directly copied
from the insert hyperlink dialog) and pasted into your message.



fordrules01 wrote:

Hi,

Completely new to VBA in Excel. I've got a large number of excel files
(approx 600) all which contain up to 20 hyperlinks to drawings and other
files contained on a workgrouped computer. Due to the computer crashing we
have had to move all these drawings to another computer and i need to find a
way to update what is potentially 12,000 hyperlinks. (i'm aware that the
setup of these computers is by no means ideal)

Anyway i've tried to copy some vba off the microsoft site with no luck as
yet. If anyone can find the error or has a better solution please let me know.

Code below: (http://support.microsoft.com/default...b;en-us;247507)

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink

' These can be any text portion of a hyperlink, such as ".com" or ".org".
oldtext = "/Matt"
newtext = "/Bob"

' Check all hyperlinks on active sheet.
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next
End Sub

Cheers

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson

Updating Hyperlinks with VBA
 

Thankyou very much to both of you.

Leung; I believe this is exactly what i'm after but so far have had no luck
getting it to work. I'm a novice with VBA so it may be something very simple
i'm doing wrong. I'll try to explain every step i took in detail.

1) copied the code below into a new module in a new workbook "Master
Hyperlink Rename.xls"
2) Set up a folder "C:\Documents and Settings\Matt\Desktop\Test\" which
contained 2 test workbooks with hyperlinks (hyperlinked to picture/word files
in the same folder)
3) put the text "\Matt\" in A1 , "\Bob\" in A2, "C:\Documents and
Settings\Matt\Desktop\Test\" in A3 (Note: unsure of whether these actually
need "" around them or not but no luck either way)
4) Went to Tools Macro Macros.. and chose "Do All" and selected Run

Now heres where i got a couple of different problems.
- First, when the Master Hyperlink Rename.xls was outside the specified
folder it appeared to run something and then popped up asking if i wanted to
reopen Master Hyperlink Rename.xls and any changes would be lost.
- Second, when Master Hyperlink Rename was located inside the folder i was
wanting to modify i get the error (after it momentarily shows up a whole heap
of text in my worksheet) saying "Run-time error '1004': " could not be founf.
Check the spelling of the file name, and verify that the file location is
correct."

Any help on this would be appreciated.




"Leung" wrote:

Hi

I have created 3 Sub as below, just copy and paste to module section.
Input cells A1, A2 and A3, see below instruction.
Call the DoAll() or call it individually.

regards

Leung


==code start ==

'Three Steps:
Sub DoAll()

'please make sure A1, A2 and A3 is not empty

'Step 1 - list all hyperlink for all excels from path in cell A3 e.g.
"C:\test\"
Call FindHlinks

'Step 2 - list of hyperlink to be change from cell A1 to A2
'A1 "../abc/", "http://msn.com"
'A2 "../bcd/", "http://www.msn.com/"

Call CreateHyperlinkList

'Step 3 - Replace all
Call ReplaceAllHyperlink

End Sub



'==
'Discover all hyperlinks in a folder of spreadsheets
Sub FindHlinks()

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim i As Integer


strLookForPath = Range("A1").Value
strReplaceForPath = Range("A2").Value
MyPath = Range("A3").Value


'row to start to write down hyperlink information
i = 5

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")


'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'See if the name of your backup directory is in
'the hlink address. I searched for NewTest, but
'you will want to search for the name of your
'own backup directory
'+Previous If InStr(HL.Address, "NewTest") 0 Then
If InStr(HL.Address, strLookForPath) 0 Then
' With ThisWorkbook.Sheets(1)
' +added write to current sheet
With Workbooks("change_link.xls").Sheets(1)
'Write the info to cells
.Cells(i, 1) = CurrWb.Name
.Cells(i, 2) = sh.Name
.Cells(i, 3) = HL.Address
.Cells(i, 4) = HL.Range.Address
End With
i = i + 1
End If
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop


Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing

End Sub

' This copy and paste the col C into Col D with string replacement
' from Cell a1 to a2
Sub CreateHyperlinkList()

Dim strLookForPath As String
Dim strReplaceForPath As String

strLookForPath = Range("A1")
strReplaceForPath = Range("A2")


'existing link should start with cell C5
'copy all hyperlinks
Range("C5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'put it starting from cell E5
Range("E5").Select
ActiveSheet.Paste

Selection.Replace What:=strLookForPath,
Replacement:=strReplaceForPath, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

Range("E5").Select
Application.CutCopyMode = False


End Sub


'Perform this to replace all hyperlink
'remember to change the path

Sub ReplaceAllHyperlink()

'select range and it should start with A5
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

Dim strPara() As String
Dim i As Long

i = 1

Do While i <= Selection.Rows.Count
'do it one by one


'++change this
strMyPath = Range("A3").Value

Call ReplaceSingleHyperlink(strMyPath, _
Selection.Cells(i, 1).Value, _
Selection.Cells(i, 2).Value, _
Selection.Cells(i, 4).Value, _
Selection.Cells(i, 5).Value)
i = i + 1

Loop

End Sub


'this make the procedure more generic and reusable
Sub ReplaceSingleHyperlink(ByVal strMyPath As String, _
ByVal strWorkBookName As String, _
ByVal strSheetname As String, _
ByVal strAddress As String, _
ByVal strNewLink As String)

'no need to blinking
Application.ScreenUpdating = False

'replace one by one
Workbooks.Open (strMyPath & strWorkBookName)

ActiveWorkbook.Sheets(strSheetname).Range(strAddre ss).Hyperlinks(1).Address =
strNewLink
ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub


==code end ==






"Dave Peterson" wrote:

I would spend some time getting the macro that fixed one worksheet's hyperlinks
working. Then advance to multiple sheets, then multiple workbooks.

But maybe you can modify this:

Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim DestCell As Range
Dim RngToCopy As Range

Dim OldStr As String
Dim NewStr As String
Dim hyp As Hyperlink

OldStr = "http://192.168.15.5/"
NewStr = "http://hank.home.on.ca/"

Application.ScreenUpdating = False

'change the folder here
myPath = "C:\my documents\excel\test"
If myPath = "" Then Exit Sub
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
Application.StatusBar _
= "Processing: " & myNames(fCtr) & " at: " & Now
Set wkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

For Each wks In wkbk.Worksheets
For Each hyp In ActiveSheet.Hyperlinks
hyp.Address = Replace(hyp.Address, OldStr, NewStr)
Next hyp
Next wks

wkbk.Close savechanges:=True

Next fCtr
End If

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

fordrules01 wrote:

Dave,

I don't want to report. I do just want to update. Where i liked this code
was that it allowed me to use all the .xls files in a whole directory rather
than individual workbooks. I want to modify it so it does just automatically
update. The reporting of what has been updated may be beneficial but is a
secondary consideration.

Cheers,

Matt

"Dave Peterson" wrote:

I don't understand why you want a report--why not just update the
hyperlinks?????

fordrules01 wrote:

Dave,

I had a look through the link you mentioned and have found some code that i
need help to modify slightly. The code is from Dick Kusleika's post
http://groups.google.com/group/micro...7ae7cd9cf83f34

Unfortunately its from 2002 so i don't fancy my chances of getting a reply
in there. What i want to achieve is to modify the hyperlinks after they have

Updating Hyperlinks with VBA
 

Oh...

forget to tell you that DON'T put this file into that working directory, as
macros involve open and close those files with hyperlink.

Simply put it other place and try again.

"fordrules01" wrote:

Thankyou very much to both of you.

Leung; I believe this is exactly what i'm after but so far have had no luck
getting it to work. I'm a novice with VBA so it may be something very simple
i'm doing wrong. I'll try to explain every step i took in detail.

1) copied the code below into a new module in a new workbook "Master
Hyperlink Rename.xls"
2) Set up a folder "C:\Documents and Settings\Matt\Desktop\Test\" which
contained 2 test workbooks with hyperlinks (hyperlinked to picture/word files
in the same folder)
3) put the text "\Matt\" in A1 , "\Bob\" in A2, "C:\Documents and
Settings\Matt\Desktop\Test\" in A3 (Note: unsure of whether these actually
need "" around them or not but no luck either way)
4) Went to Tools Macro Macros.. and chose "Do All" and selected Run

Now heres where i got a couple of different problems.
- First, when the Master Hyperlink Rename.xls was outside the specified
folder it appeared to run something and then popped up asking if i wanted to
reopen Master Hyperlink Rename.xls and any changes would be lost.
- Second, when Master Hyperlink Rename was located inside the folder i was
wanting to modify i get the error (after it momentarily shows up a whole heap
of text in my worksheet) saying "Run-time error '1004': " could not be founf.
Check the spelling of the file name, and verify that the file location is
correct."

Any help on this would be appreciated.




"Leung" wrote:

Hi

I have created 3 Sub as below, just copy and paste to module section.
Input cells A1, A2 and A3, see below instruction.
Call the DoAll() or call it individually.

regards

Leung


==code start ==

'Three Steps:
Sub DoAll()

'please make sure A1, A2 and A3 is not empty

'Step 1 - list all hyperlink for all excels from path in cell A3 e.g.
"C:\test\"
Call FindHlinks

'Step 2 - list of hyperlink to be change from cell A1 to A2
'A1 "../abc/", "http://msn.com"
'A2 "../bcd/", "http://www.msn.com/"

Call CreateHyperlinkList

'Step 3 - Replace all
Call ReplaceAllHyperlink

End Sub



'==
'Discover all hyperlinks in a folder of spreadsheets
Sub FindHlinks()

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim i As Integer


strLookForPath = Range("A1").Value
strReplaceForPath = Range("A2").Value
MyPath = Range("A3").Value


'row to start to write down hyperlink information
i = 5

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")


'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'See if the name of your backup directory is in
'the hlink address. I searched for NewTest, but
'you will want to search for the name of your
'own backup directory
'+Previous If InStr(HL.Address, "NewTest") 0 Then
If InStr(HL.Address, strLookForPath) 0 Then
' With ThisWorkbook.Sheets(1)
' +added write to current sheet
With Workbooks("change_link.xls").Sheets(1)
'Write the info to cells
.Cells(i, 1) = CurrWb.Name
.Cells(i, 2) = sh.Name
.Cells(i, 3) = HL.Address
.Cells(i, 4) = HL.Range.Address
End With
i = i + 1
End If
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop


Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing

End Sub

' This copy and paste the col C into Col D with string replacement
' from Cell a1 to a2
Sub CreateHyperlinkList()

Dim strLookForPath As String
Dim strReplaceForPath As String

strLookForPath = Range("A1")
strReplaceForPath = Range("A2")


'existing link should start with cell C5
'copy all hyperlinks
Range("C5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'put it starting from cell E5
Range("E5").Select
ActiveSheet.Paste

Selection.Replace What:=strLookForPath,
Replacement:=strReplaceForPath, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

Range("E5").Select
Application.CutCopyMode = False


End Sub


'Perform this to replace all hyperlink
'remember to change the path

Sub ReplaceAllHyperlink()

'select range and it should start with A5
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

Dim strPara() As String
Dim i As Long

i = 1

Do While i <= Selection.Rows.Count
'do it one by one


'++change this
strMyPath = Range("A3").Value

Call ReplaceSingleHyperlink(strMyPath, _
Selection.Cells(i, 1).Value, _
Selection.Cells(i, 2).Value, _
Selection.Cells(i, 4).Value, _
Selection.Cells(i, 5).Value)
i = i + 1

Loop

End Sub


'this make the procedure more generic and reusable
Sub ReplaceSingleHyperlink(ByVal strMyPath As String, _
ByVal strWorkBookName As String, _
ByVal strSheetname As String, _
ByVal strAddress As String, _
ByVal strNewLink As String)

'no need to blinking
Application.ScreenUpdating = False

'replace one by one
Workbooks.Open (strMyPath & strWorkBookName)

ActiveWorkbook.Sheets(strSheetname).Range(strAddre ss).Hyperlinks(1).Address =
strNewLink
ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub


==code end ==






"Dave Peterson" wrote:

I would spend some time getting the macro that fixed one worksheet's hyperlinks
working. Then advance to multiple sheets, then multiple workbooks.

But maybe you can modify this:

Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim DestCell As Range
Dim RngToCopy As Range

Dim OldStr As String
Dim NewStr As String
Dim hyp As Hyperlink

OldStr = "http://192.168.15.5/"
NewStr = "http://hank.home.on.ca/"

Application.ScreenUpdating = False

'change the folder here
myPath = "C:\my documents\excel\test"
If myPath = "" Then Exit Sub
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
Application.StatusBar _
= "Processing: " & myNames(fCtr) & " at: " & Now
Set wkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

For Each wks In wkbk.Worksheets
For Each hyp In ActiveSheet.Hyperlinks
hyp.Address = Replace(hyp.Address, OldStr, NewStr)
Next hyp
Next wks

wkbk.Close savechanges:=True

Next fCtr
End If

With Application
.ScreenUpdating = True
.StatusBar = False

Updating Hyperlinks with VBA
 

Ok have tried it when outside the directory and appears to be doing a whole
heap of stuff but then pops up with the same error message. When i go to
debug it highlights the line.

Workbooks.Open (strMyPath & strWorkBookName)

Cheers,

Matt

"Leung" wrote:

Oh...

forget to tell you that DON'T put this file into that working directory, as
macros involve open and close those files with hyperlink.

Simply put it other place and try again.

"fordrules01" wrote:

Thankyou very much to both of you.

Leung; I believe this is exactly what i'm after but so far have had no luck
getting it to work. I'm a novice with VBA so it may be something very simple
i'm doing wrong. I'll try to explain every step i took in detail.

1) copied the code below into a new module in a new workbook "Master
Hyperlink Rename.xls"
2) Set up a folder "C:\Documents and Settings\Matt\Desktop\Test\" which
contained 2 test workbooks with hyperlinks (hyperlinked to picture/word files
in the same folder)
3) put the text "\Matt\" in A1 , "\Bob\" in A2, "C:\Documents and
Settings\Matt\Desktop\Test\" in A3 (Note: unsure of whether these actually
need "" around them or not but no luck either way)
4) Went to Tools Macro Macros.. and chose "Do All" and selected Run

Now heres where i got a couple of different problems.
- First, when the Master Hyperlink Rename.xls was outside the specified
folder it appeared to run something and then popped up asking if i wanted to
reopen Master Hyperlink Rename.xls and any changes would be lost.
- Second, when Master Hyperlink Rename was located inside the folder i was
wanting to modify i get the error (after it momentarily shows up a whole heap
of text in my worksheet) saying "Run-time error '1004': " could not be founf.
Check the spelling of the file name, and verify that the file location is
correct."

Any help on this would be appreciated.




"Leung" wrote:

Hi

I have created 3 Sub as below, just copy and paste to module section.
Input cells A1, A2 and A3, see below instruction.
Call the DoAll() or call it individually.

regards

Leung


==code start ==

'Three Steps:
Sub DoAll()

'please make sure A1, A2 and A3 is not empty

'Step 1 - list all hyperlink for all excels from path in cell A3 e.g.
"C:\test\"
Call FindHlinks

'Step 2 - list of hyperlink to be change from cell A1 to A2
'A1 "../abc/", "http://msn.com"
'A2 "../bcd/", "http://www.msn.com/"

Call CreateHyperlinkList

'Step 3 - Replace all
Call ReplaceAllHyperlink

End Sub



'==
'Discover all hyperlinks in a folder of spreadsheets
Sub FindHlinks()

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim i As Integer


strLookForPath = Range("A1").Value
strReplaceForPath = Range("A2").Value
MyPath = Range("A3").Value


'row to start to write down hyperlink information
i = 5

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")


'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'See if the name of your backup directory is in
'the hlink address. I searched for NewTest, but
'you will want to search for the name of your
'own backup directory
'+Previous If InStr(HL.Address, "NewTest") 0 Then
If InStr(HL.Address, strLookForPath) 0 Then
' With ThisWorkbook.Sheets(1)
' +added write to current sheet
With Workbooks("change_link.xls").Sheets(1)
'Write the info to cells
.Cells(i, 1) = CurrWb.Name
.Cells(i, 2) = sh.Name
.Cells(i, 3) = HL.Address
.Cells(i, 4) = HL.Range.Address
End With
i = i + 1
End If
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop


Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing

End Sub

' This copy and paste the col C into Col D with string replacement
' from Cell a1 to a2
Sub CreateHyperlinkList()

Dim strLookForPath As String
Dim strReplaceForPath As String

strLookForPath = Range("A1")
strReplaceForPath = Range("A2")


'existing link should start with cell C5
'copy all hyperlinks
Range("C5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'put it starting from cell E5
Range("E5").Select
ActiveSheet.Paste

Selection.Replace What:=strLookForPath,
Replacement:=strReplaceForPath, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

Range("E5").Select
Application.CutCopyMode = False


End Sub


'Perform this to replace all hyperlink
'remember to change the path

Sub ReplaceAllHyperlink()

'select range and it should start with A5
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

Dim strPara() As String
Dim i As Long

i = 1

Do While i <= Selection.Rows.Count
'do it one by one


'++change this
strMyPath = Range("A3").Value

Call ReplaceSingleHyperlink(strMyPath, _
Selection.Cells(i, 1).Value, _
Selection.Cells(i, 2).Value, _
Selection.Cells(i, 4).Value, _
Selection.Cells(i, 5).Value)
i = i + 1

Loop

End Sub


'this make the procedure more generic and reusable
Sub ReplaceSingleHyperlink(ByVal strMyPath As String, _
ByVal strWorkBookName As String, _
ByVal strSheetname As String, _
ByVal strAddress As String, _
ByVal strNewLink As String)

'no need to blinking
Application.ScreenUpdating = False

'replace one by one
Workbooks.Open (strMyPath & strWorkBookName)

ActiveWorkbook.Sheets(strSheetname).Range(strAddre ss).Hyperlinks(1).Address =
strNewLink
ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub


==code end ==






"Dave Peterson" wrote:

I would spend some time getting the macro that fixed one worksheet's hyperlinks
working. Then advance to multiple sheets, then multiple workbooks.

But maybe you can modify this:

Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim DestCell As Range
Dim RngToCopy As Range

Dim OldStr As String
Dim NewStr As String
Dim hyp As Hyperlink

OldStr = "http://192.168.15.5/"
NewStr = "http://hank.home.on.ca/"

Application.ScreenUpdating = False

'change the folder here
myPath = "C:\my documents\excel\test"
If myPath = "" Then Exit Sub
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
Application.StatusBar _
= "Processing: " & myNames(fCtr) & " at: " & Now
Set wkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

For Each wks In wkbk.Worksheets
For Each hyp In ActiveSheet.Hyperlinks
hyp.Address = Replace(hyp.Address, OldStr, NewStr)
Next hyp
Next wks

Updating Hyperlinks with VBA
 

The sub stops there because it cannot open the file, is it related to
priviledge problem?

it stop at the first one or some file in the middle? What the program does
is first to list all the hyperlink, secondly to copy and paste the link with
the values specified, the thirdly open the file with specified worksheet and
change the hyperlink at the address specified with the valued changed.



"fordrules01" wrote:

Ok have tried it when outside the directory and appears to be doing a whole
heap of stuff but then pops up with the same error message. When i go to
debug it highlights the line.

Workbooks.Open (strMyPath & strWorkBookName)

Cheers,

Matt

"Leung" wrote:

Oh...

forget to tell you that DON'T put this file into that working directory, as
macros involve open and close those files with hyperlink.

Simply put it other place and try again.

"fordrules01" wrote:

Thankyou very much to both of you.

Leung; I believe this is exactly what i'm after but so far have had no luck
getting it to work. I'm a novice with VBA so it may be something very simple
i'm doing wrong. I'll try to explain every step i took in detail.

1) copied the code below into a new module in a new workbook "Master
Hyperlink Rename.xls"
2) Set up a folder "C:\Documents and Settings\Matt\Desktop\Test\" which
contained 2 test workbooks with hyperlinks (hyperlinked to picture/word files
in the same folder)
3) put the text "\Matt\" in A1 , "\Bob\" in A2, "C:\Documents and
Settings\Matt\Desktop\Test\" in A3 (Note: unsure of whether these actually
need "" around them or not but no luck either way)
4) Went to Tools Macro Macros.. and chose "Do All" and selected Run

Now heres where i got a couple of different problems.
- First, when the Master Hyperlink Rename.xls was outside the specified
folder it appeared to run something and then popped up asking if i wanted to
reopen Master Hyperlink Rename.xls and any changes would be lost.
- Second, when Master Hyperlink Rename was located inside the folder i was
wanting to modify i get the error (after it momentarily shows up a whole heap
of text in my worksheet) saying "Run-time error '1004': " could not be founf.
Check the spelling of the file name, and verify that the file location is
correct."

Any help on this would be appreciated.




"Leung" wrote:

Hi

I have created 3 Sub as below, just copy and paste to module section.
Input cells A1, A2 and A3, see below instruction.
Call the DoAll() or call it individually.

regards

Leung


==code start ==

'Three Steps:
Sub DoAll()

'please make sure A1, A2 and A3 is not empty

'Step 1 - list all hyperlink for all excels from path in cell A3 e.g.
"C:\test\"
Call FindHlinks

'Step 2 - list of hyperlink to be change from cell A1 to A2
'A1 "../abc/", "http://msn.com"
'A2 "../bcd/", "http://www.msn.com/"

Call CreateHyperlinkList

'Step 3 - Replace all
Call ReplaceAllHyperlink

End Sub



'==
'Discover all hyperlinks in a folder of spreadsheets
Sub FindHlinks()

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim i As Integer


strLookForPath = Range("A1").Value
strReplaceForPath = Range("A2").Value
MyPath = Range("A3").Value


'row to start to write down hyperlink information
i = 5

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")


'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'See if the name of your backup directory is in
'the hlink address. I searched for NewTest, but
'you will want to search for the name of your
'own backup directory
'+Previous If InStr(HL.Address, "NewTest") 0 Then
If InStr(HL.Address, strLookForPath) 0 Then
' With ThisWorkbook.Sheets(1)
' +added write to current sheet
With Workbooks("change_link.xls").Sheets(1)
'Write the info to cells
.Cells(i, 1) = CurrWb.Name
.Cells(i, 2) = sh.Name
.Cells(i, 3) = HL.Address
.Cells(i, 4) = HL.Range.Address
End With
i = i + 1
End If
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop


Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing

End Sub

' This copy and paste the col C into Col D with string replacement
' from Cell a1 to a2
Sub CreateHyperlinkList()

Dim strLookForPath As String
Dim strReplaceForPath As String

strLookForPath = Range("A1")
strReplaceForPath = Range("A2")


'existing link should start with cell C5
'copy all hyperlinks
Range("C5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'put it starting from cell E5
Range("E5").Select
ActiveSheet.Paste

Selection.Replace What:=strLookForPath,
Replacement:=strReplaceForPath, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

Range("E5").Select
Application.CutCopyMode = False


End Sub


'Perform this to replace all hyperlink
'remember to change the path

Sub ReplaceAllHyperlink()

'select range and it should start with A5
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

Dim strPara() As String
Dim i As Long

i = 1

Do While i <= Selection.Rows.Count
'do it one by one


'++change this
strMyPath = Range("A3").Value

Call ReplaceSingleHyperlink(strMyPath, _
Selection.Cells(i, 1).Value, _
Selection.Cells(i, 2).Value, _
Selection.Cells(i, 4).Value, _
Selection.Cells(i, 5).Value)
i = i + 1

Loop

End Sub


'this make the procedure more generic and reusable
Sub ReplaceSingleHyperlink(ByVal strMyPath As String, _
ByVal strWorkBookName As String, _
ByVal strSheetname As String, _
ByVal strAddress As String, _
ByVal strNewLink As String)

'no need to blinking
Application.ScreenUpdating = False

'replace one by one
Workbooks.Open (strMyPath & strWorkBookName)

ActiveWorkbook.Sheets(strSheetname).Range(strAddre ss).Hyperlinks(1).Address =
strNewLink
ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub


==code end ==






"Dave Peterson" wrote:

I would spend some time getting the macro that fixed one worksheet's hyperlinks
working. Then advance to multiple sheets, then multiple workbooks.

But maybe you can modify this:

Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim DestCell As Range
Dim RngToCopy As Range

Dim OldStr As String
Dim NewStr As String
Dim hyp As Hyperlink

OldStr = "http://192.168.15.5/"
NewStr = "http://hank.home.on.ca/"

Application.ScreenUpdating = False

'change the folder here
myPath = "C:\my documents\excel\test"
If myPath = "" Then Exit Sub
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop