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

[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

Any help appreciated.

TIA

Ron

 

[Dave Peterson]

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

 

[Dave Peterson]

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.

 

[Ron]

Dave,

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

Thank you

Ron

 

[Dave Peterson]

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>).

 

[Ron]

Dave,

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

TIA

Ron

 

[Dave Peterson]

Existing formula could look like:

=hyperlink("http://www.mzmz.com/az/az_detail.php?save=1&id=123456", "Click Me")

edit|replace
what: http://www.mzmz.com/az/az_detail.php?save=1&id=
with: file:///C:\Documents and Settings\R\My Documents\T\AUS\2007\Data\
replace all

And maybe...
edit|replace
what: ", "Click me"
with: .mht", "Click me"
replace all

This _might_ work. I didn't spend too much time looking for the correct from/to
strings in the previous posts.