Excel Contains E-mail Addresses

[Carl]

I inherited an Excel 2003 file with 985 email address in them. The problem is
that they exist in Excel as hyperlinks, which when clicked on launch a new
Outlook email.
I need to send all these email address to an outside vendor. How can I
convert all these hyperlinks, displayed as John Doe in Excle, to a column of
email address (such as (e-mail address removed)).
I posted in an Outlook group and an Outlook MVP thought I might be better
posting this question here.
Thank you
Carl

 

[Sheeloo]

Can you give a few examples of the hyperlinks?

Do they have mailto: before the email address?
If yes, then try this in B1 (assuming that you have the address in A1)
=RIGHT(A1,LEN(A1)-7)
if this works then you can copy it down...

 

[Ron de Bruin]

This will add the addess in the column next to it
Be sure that there is a empty column next to the hyperlimks column

Sub ShowLinks()
Dim hlnk As Hyperlink
For Each hlnk In ActiveSheet.Hyperlinks
hlnk.Parent.Offset(0, 1).Value = Mid(hlnk.Address, 8, 100)
Next
End Sub

 

[Sheeloo]

Ron,

I tried to use hlink.Address in a macro but it did not work for links
inserted using formulas like;
=HYPERLINK("mailto:[email protected]","ABC Mail Id")

I tried to come up with a code which will take care of that for all
addresses and came up with the following;
(It assumes all hyperlinks are in Col A and writes out in Col B)

Sub test()

With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

For i = 1 To lastRow

endPos = InStr(13, Cells(i, 1).Formula, ",")

If (endPos > 13) Then
lastpos = Len(Cells(i, 1).Formula)
Cells(i, 2) = Mid(Cells(i, 1).Formula, 13, (endPos - 14))
Else
If (Left(Cells(i, 1), 7) = "mailto:") Then
Cells(i, 2) = Right(Cells(i, 1), (Len(Cells(i, 1)) - 7))
Else
Cells(i, 2) = Cells(i, 1)
End If

End If
If (Left(Cells(i, 2), 7) = "mailto:") Then
Cells(i, 2) = Right(Cells(i, 2), (Len(Cells(i, 2)) - 7))
End If
Next
End Sub

 

[Carl]

Thanks Ron, works perfectly. And is easy to implement for a VB neophyte.

 

[Ron de Bruin]

Hi Sheelo

Maybe this is easier

Sub ShowLinks2()
Dim hlnk As Hyperlink
For Each hlnk In ActiveSheet.Hyperlinks
hlnk.Parent.Offset(0, 1).Value = Mid(hlnk.Address, 8, InStr(1, hlnk.Address, "%") - 8)
Next
End Sub


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm