Last week I got a mail from my friend asking for help in extracting email IDs from data available with him. The position of the mail IDs within the text string was not same and he was finding it difficult to us extract email addresses.
I wrote a quick UDF for him which did the job. I am sharing same with you as you may find it use full.
Sample of the data and mail IDs extracted with the UDF is as below
Here is the VBA code to Email Address Extract from String. You will need to
copy this code to regular VBA module of your workbook
Function Getmailid(cell As Range) As String
Dim Textstrng As String
Textstrng = cell.Text
Position@ = InStr(1, Textstrng, "@")
EmStart = InStrRev(Textstrng, " ", Position@)
If EmStart = 0 Then EmStart = 1
EmEnd = InStr(Position@, Textstrng, " ")
If EmEnd = 0 Then EmEnd = Len(Textstrng) + 1
mailid = Trim(Mid(Textstrng, EmStart, EmEnd - EmStart))
If Right(mailid, 1) = "." Then
Getmailid = Left(mailid, Len(mailid) - 1)
Else
Getmailid = mailid
End If
End Function
|
Download file with VBA code to Email Address Extract from Text String
8 comments:
Did you change your code displayer? I don't remember this happening before, but when I copy/pasted your code into my copy of XL2003, everything was on a single line (that is, there were no line feeds between the individual statements).
Here is a worksheet formula that will extract an email address from the text in a cell...
=TRIM(RIGHT(SUBSTITUTE(LEFT(A1,FIND("@",A1)-1)," ",REPT(" ",99)),99))&MID(A1,FIND("@",A1),FIND(" ",A1&" ",FIND("@",A1))-FIND("@",A1))
In case your code displayer ends up breaking the line at blank spaces, I just want to point out that there are three blank spaces surrounded by quote marks in the formula... one on each side of the REPT function and one after the third FIND function.
Rick Rothstein (MVP - Excel)
I just noticed that my formula has **four** blank spaces in it, not three and it looks like your display word wrapped it at the space I forgot to count. However, that should not matter since when I copy the formula from your webpage, it pastes correctly into Excel's Formula Bar as a single continuous line.
Hello Rick
I have not made any change in the code display. Could not understand why is it behaving like this. You can download the excel file having the code.
Thanks for your formula input.
Regards//Yogesh Gupta
Here is a macro that is a little more robust than the one you posted... instead of using just a blank space to delimit the email address from the rest of the text, it uses any character that is invalid in an email address to delimit the email address from the rest of the text. That way, you will be able to retrieve the email address if it is, for example, surrounded by parentheses, quote marks, etc. You will also be able to find the email address if it located at the end of a sentence (email addresses cannot start or end with a dot). Here is the code...
Function GetEmailAddress(ByVal S As String) As String
Dim X As Long, AtSign As Long
Dim Locale As String, DomainPart As String
Locale = "[A-Za-z0-9.!#$%&'*/=?^_`{|}~+-]"
Domain = "[A-Za-z0-9._-]"
AtSign = InStr(S, "@")
For X = AtSign To 1 Step -1
If Not Mid(" " & S, X, 1) Like Locale Then
S = Mid(S, X)
If Left(S, 1) = "." Then S = Mid(S, 2)
Exit For
End If
Next
For X = AtSign + 1 To Len(S) + 1
If Not Mid(S & " ", X, 1) Like Domain Then
S = Left(S, X - 1)
If Right(S, 1) = "." Then S = Left(S, Len(S) - 1)
GetEmailAddress = S
Exit For
End If
Next
End Function
Also note that I changed the argument's data type from Range to String... doing this still allows you to pass a cell reference into it when using it as a UDF, but it also allows you to pass it a simple text string as well (useful if you want to use the function in a non-UDF setting).
Rick Rothstein (MVP - Excel)
Hi Rick
Thanks for your inputs. I tested the code and feel that there is some gap. After the first for next blok, "AtSign" variable needs to be recalculated by using statement
AtSign = InStr(S, "@")
It works fine after this change.
I have updated the file at download link in the original post to include your code after this correction.
Regards//Yogesh Gupta
Good catch! That is what I get for making last minute changes and not testing them. I'm glad spotted the problem and were able to figure out the solution. Thanks.
Just a thought... as long as you decided to include my code in the download file, you might want to include a comment as to what the difference is between your code and mine, just in case someone reads your blog entry and downloads the file directly without reading the comments.
Rick Rothstein (MVP - Excel)
Though I had included credits to you in the download file but not mentined about the differnece between two.
Now I have mentioned the difference and updated the file at download link.
Now some thing beyond this post. I want to invite you for guest post on my blog. Any topic or any tips of your choice. Let me know if you are okay with this. I will be honored if you accept my invite.
Post a Comment