extract urls from hyperlinked images

**simarui** · 01-18-2012, 04:00 PM

I have a list of about 1000 documents and folders each with an associated picture embedded with a hyperlink. I am trying to extract the hyperlinks from those pictures and keep them aligned with thier associated document/folder.

the following macro, originally posted by Leith Ross in 2005:

Sub GetHyperlinks()

  Dim NextRow As Long
  Dim Shp As Object
  
    NextRow = 1
    
    For Each Shp In ActiveSheet.Shapes
      If Shp.Type = msoPicture Then
        Cells(NextRow, "A") = Shp.Hyperlink.Address
        NextRow = NextRow + 1
      End If
    Next Shp
    
End Sub

worked really well, except that it seems to duplicate all of the true urls. when i run the macro on my full list, i end up with 1000 extra urls, and matching them up to their associated doc/folder is nearly impossible.

Also of note, when it duplicates the url, it often adds one more space to the front, so removing duplicates doesn't really seem to help.

please help?

**simarui** · 01-18-2012, 04:11 PM

I kept looking and found it elsewhere, but just in case someone else stumbles here ...

Sub Test1()
Application.ScreenUpdating = False
Dim Sh As Shape
For Each Sh In ActiveSheet.Shapes
With Sh
If Left(.Name, 7) = "Picture" Then
On Error Resume Next
Range(.TopLeftCell.Address).Offset(0, 3).Value = .Hyperlink.Address
On Error GoTo 0
End If
End With
Next Sh
Application.ScreenUpdating = True
End Sub

This did exactly what i wanted. fairly confident the error trap there helped alot.