Excel VBA HyperLink copy/paste/update error

[tpoje]

Using Excel 2002/2003 on XP-SP3. Have a spreadsheet with a column (B) of hyperlinks to online documentation (pdf files). I wanted to copy column(B) to D and convert HyperLink Address & TextToDisplay to local pdf file references, and preserve the orginal hyperlinks for future reference.

The code below works fine, except that when it changes the Address on the selected hyperlink (D), the source hyperlink address (B) changes as well. Strangely, the TextToDisplay does not (it works as expected).

Any chance someone can point out what I'm missing?


Sub HyperLinkChange()

Dim path, file As String
Dim h As Hyperlink
Dim x As Integer

Columns("B:B").Select
Selection.Copy
Columns("D:D").Select
ActiveSheet.Paste
Application.CutCopyMode = False

path = "http://www.abc.com/epubs/pdf/"
file = ""

For Each h In ActiveSheet.Columns("D:D").Hyperlinks
x = InStr(1, h.Address, path)
If x > 0 Then
file = Replace(h.Address, path, "")
h.Address = file ' This is the problem - it updates both hyperlinks
h.TextToDisplay = file
End If
Next
End Sub

 

[mike31z]

Can you use the formula "=T()" in the adjoining cell.

That should return the text related to the hyperlink.

 

[tpoje]

Thanks for looking, but I don't see how it addresses the issue. For the record, I've come up with a working solution that gets around the multiple address update (see below), so this is more a question of object behavior in the original case than seeking a working solution.

Let me try to restate the problem: starting with a column of hyperlinks pointing to web documents, I want a second column of hyperlinks to local files so I can have fast local access to downloaded files and still get to the web based originals (there are hundreds of them). Using Copy/Paste/h.Address (in original module) updates more than one hyperlink. I'm just trying to understand what I did wrong in the object reference to cause that behavior.

This code works:

Sub HyperLinkChange()

Dim path, file As String
Dim h As Hyperlink
Dim x As Integer
Dim rngDst As Range 'Destination Cell
Dim rngSrc As Range 'Source Cell

path = "http://www.abc.com/epubs/pdf/"
file = ""

For Each h In ActiveSheet.Range("B:B").Hyperlinks
Set rngSrc = h.Range
Set rngDst = rngSrc.Offset(0, 2)
x = InStr(1, h.Address, path)
If x > 0 Then
file = Replace(h.Address, path, "")
End If
ActiveSheet.Hyperlinks.Add rngDst, file, , , file
Next h
End Sub