Replace Hyperlink Addresses Help 'Dim OldStr As String, NewStr As String

  • Thread starter Thread starter Ron
  • Start date Start date
R

Ron

In an Excel2002 worksheet Col B is populated daily with 50-80 rows of
web page data all B cells with hyperlinks.

eg.
"http://www.mzmz.com/az/az_detail.php?save=1&id=158890PHPSESSID=andlotsoftrash789"

The Col B Cells link location is constant through the "&id=" after
which they change for each web page.

I need to change the above external hyperlink address to a local
address with a web archive file type extension.

eg. "file:///C:\Documents and Settings\R\My
Documents\T\AUS\2007\Data\158890.mht"

I changed the following code (courtesy of David McRitchie's site) but
cannot figure out how to handle the changing ID numbers.
Dim OldStr As String, NewStr As String
Dim hyp As Hyperlink
OldStr = "http://www.mzmz.com/az/az_detail.php?save=1&id="
NewStr = "file:///c:\Documents and Settings\R\My Documents\T\AUS\2007\Data\
Sheets("Sheet3").Select
For Each hyp In ActiveSheet.Hyperlinks
hyp.Address = Replace(hyp.Address, OldStr, NewStr)
Next hyp
Click to expand...

Any help appreciated.

TIA

Ron
 
Maybe just extracting the &id= stuff, then deleting the old link and adding a
new one would work better:

Option Explicit
Sub testme01()

Dim myCell As Range
Dim myRng As Range
Dim wks As Worksheet
Dim myId As String
Dim IDPos As String
Dim NewURL As String

Set wks = Worksheets("sheet1")

NewURL _
= "file:///C:\Documents and Settings\R\My Documents\T\AUS\2007\Data\"

With wks
Set myRng = .Range("b1", .Cells(.Rows.Count, "B").End(xlUp))
End With

For Each myCell In myRng.Cells
With myCell
If .Hyperlinks.Count > 0 Then
IDPos = InStr(1, .Hyperlinks(1).Address, "&id=", vbTextCompare)
If IDPos > 0 Then
myId = Mid(.Hyperlinks(1).Address, IDPos + 4, 6)
.Hyperlinks.Delete
.Hyperlinks.Add anchor:=.Cells, _
Address:=NewURL & myId & ".mht"
End If
End If
End With
Next myCell

End Sub
 
ps. This line:

myId = Mid(.Hyperlinks(1).Address, IDPos + 4, 6)
takes 6 characters. You may want to change this if the id isn't always 6
digits.
 
Dave,

Tested the code and it worked perfectly straight out of the box....
you folks are the GREATEST.

Thank you

Ron
 
You may want to consider using the =hyperlink() function in the future.

Since they're just worksheet functions, they can be much easier to work with
(edit|Replace can work wonders <bg>).
 
Dave,

Could you give me a couple lines as an example of what you mean with
the Hyperlink()......... edit/REPLACE.

TIA

Ron
 
Back
Top