Module code

[keithbc]

Hi All

I found this code online to extract email addresses from a string, it works perfectly, except when there are more than 1 email, it will extract them all without a space or comma in between each address. can someone please help me to update the code to add a space or comma between the addresses.
Thanks.

Function ExtractEmailFun(extractStr As String) As String 'Update 20130829 
Dim CharList As String 
On Error Resume Next 
CheckStr = "[A-Za-z0-9._-]" OutStr = "" Index = 1 Do While True Index1 = VBA.InStr(Index, extractStr, "@") getStr = "" If Index1 > 0 Then For p = Index1 - 1 To 1 Step -1 If Mid(extractStr, p, 1) Like CheckStr Then getStr = Mid(extractStr, p, 1) & getStr Else Exit For End If Next getStr = getStr & "@" For p = Index1 + 1 To Len(extractStr) If Mid(extractStr, p, 1) Like CheckStr Then getStr = getStr & Mid(extractStr, p, 1) Else Exit For End If Next Index = Index1 + 1 If OutStr = "" Then OutStr = getStr Else OutStr = OutStr & Chr(10) & getStr End If Else Exit Do End If Loop ExtractEmailFun = OutStr 
End Function

 

[FormR]

it will extract them all without a space or comma in between each address. can someone please help me to update the code to add a space or comma between the addresses.

Hi, not tested this, but it looks like it separates them with a carriage return, if you want to use a comma instead - try changing this line:

OutStr = OutStr & Chr(10) & getStr

To

OutStr = OutStr & ", " & getStr 

 

[keithbc]

Worked perfectly, thank you.

Hi, not tested this, but it looks like it separates them with a carriage return, if you want to use a comma instead - try changing this line:

OutStr = OutStr & Chr(10) & getStr

To

OutStr = OutStr & ", " & getStr 

 

[boyn0010]

Hello FormR, can you please tell me if there is a way to modify this code to only deliver the first result for @? I only want to pull the first email that is in the cell. Thanks.

 

[FormR]

is a way to modify this code

Hi, that code is garbled for me! It was probably posted using HTML which doesn't get parsed by the new forum software.

In the absence of example data or a written description, here is formula you could try.

Book1
	A	B
1	ds fds fdsfsdf sdf me@internet.com fds fds fds another@world.com	me@internet.com
Sheet1

Cell Formulas
Range	Formula
B1	B1	=TRIM(RIGHT(SUBSTITUTE(LEFT(A1,FIND(" ",A1&" ",FIND("@",A1))-1)," ",REPT(" ",255)),255))