Help with Hyperlink...Mr. Dave Peterson's Code

[ashish352]

Hi,
I have downloaded Email (Col A), Names (Col B), Address (Col C), etc
from the net (about 1000+). I wish to send each one of them an email
with the profile of our company.

I searched the groups and found the following routine.
Sub testme02()
Dim myPict As Picture
Dim myHyperLink As Hyperlink
Set myPict = ActiveSheet.Pictures(1)
Set myHyperLink = Nothing
On Error Resume Next
Set myHyperLink = myPict.ShapeRange.Item(1).Hyperlink
On Error GoTo 0
If myHyperLink Is Nothing Then
MsgBox "no links"
Else
MsgBox myHyperLink.Address
End If
End Sub
The Emails in Col A are pictures. I wish to have the above routine to
extract mail address from each picture and copy it in Col D in
respective rows. At present I am doing "Right Click-Edit
Hyperlink-Copy the email address-Go To Col D and Paste... which is very
very time consuming.

I am using Excel 2003.
Your help would be appreciated.

Ashish Kumar

 

[Ron de Bruin]

Try this one

Sub Test()
Dim myshape As Shape
Dim myHyperLink As Hyperlink

For Each myshape In ActiveSheet.Shapes
If myshape.TopLeftCell.Column = 1 Then
Set myHyperLink = Nothing
On Error Resume Next
Set myHyperLink = myshape.Hyperlink
On Error GoTo 0
If myHyperLink Is Nothing Then
MsgBox "no link"
Else
Cells(myshape.TopLeftCell.Row, "D").Value = myshape.Hyperlink.Address
End If
End If
Next myshape
End Sub

 

[Ron de Bruin]

You can change the msgbox to
Cells(myshape.TopLeftCell.Row, "D").Value = "No link"

 

[Jim Cone]

Sounds like "Spam" to me.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


<[email protected]>
wrote in message
Hi,
I have downloaded Email (Col A), Names (Col B), Address (Col C), etc
from the net (about 1000+). I wish to send each one of them an email
with the profile of our company.
....
I am using Excel 2003.
Your help would be appreciated.

Ashish Kumar

 

[ashish352]

Thanks Mr. Ron,
Great help from you.

Ashish Kumar