Have a vba code that extracts the email address from a string. Can it be modified to exclude a list of email address?

The below code works great, but sometimes the target email address is not the first one in the string.  There are 2 email addresses that are a constantly ahead of the target email address that I want to skip/exclude from the search.

Function ExtractEmailAddress(s As String) As String
    Dim AtSignLocation As Long
    Dim i As Long
    Dim TempStr As String
    Const CharList As String = "[A-Za-z0-9._-]"
    
    'Get location of the @
    AtSignLocation = InStr(s, "@")
    If AtSignLocation = 0 Then
        ExtractEmailAddress = "" 'not found
    Else
        TempStr = ""
        'Get 1st half of email address
        For i = AtSignLocation - 1 To 1 Step -1
            If Mid(s, i, 1) Like CharList Then
                TempStr = Mid(s, i, 1) & TempStr
            Else
                Exit For
            End If
        Next i
        If TempStr = "" Then Exit Function
        'get 2nd half
        TempStr = TempStr & "@"
        For i = AtSignLocation + 1 To Len(s)
            If Mid(s, i, 1) Like CharList Then
                TempStr = TempStr & Mid(s, i, 1)
            Else
                Exit For
            End If
        Next i
    End If
    'Remove trailing period if it exists
    If Right(TempStr, 1) = "." Then TempStr = _
       Left(TempStr, Len(TempStr) - 1)
    ExtractEmailAddress = TempStr
End Function

Open in new window

kbay808Asked:
Who is Participating?
 
Rgonzo1971Commented:
Hi,

pls try ( with reference to Microsoft VBScript Regular Expressions)

Function ExtractEmailAddress(s As String) As String
    Dim regEx As New RegExp
    Dim strPattern As String
    Dim strInput As String
    Dim strReplace As String
    Dim strOutput As String
    
    
    strPattern = "\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}"

    With regEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = strPattern
    End With
    Set Matches = regEx.Execute(s)
    If Matches.Count > 1 Then
        Select Case Matches(0)
            Case "aa@aa.com", "bb@bb.com"
                Res = Matches(1)
            Case Else
                Res = Matches(0)
        End Select

    ElseIf Matches.Count = 1 Then
        Res = Matches(0)
    Else ' 0
        Res = ""
    End If
ExtractEmailAddress = Res
End Function

Open in new window

you can change the unwanted emails on line 20

Regards
0
 
KimputerCommented:
Can you give a few of these input strings, what the current output is, what you like the output to be? If it returns an empty string, is the original code (that calls this function) able to handle it?
0
 
FarWestCommented:
you can put this code at the beginning of your function, it will remove the emails from that you want to ignore from the parameter variable

    'processing emails to be ommited
    
       Dim oEmails() As String
        oEmails = Split("oemail1.mmm.com;/oemai2.cmmc.com;", "/")
       Dim ioc As Integer
       For ioc = 1 To UBound(oEmails)
       s = Replace(s, oEmails(ioc), "")
      Next

Open in new window


Good Luck
0
Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

 
kbay808Author Commented:
@Rgonzo1971 – Thanks, your code works a lot better than the one I was using.

@FarWest – I can’t get you code to exclude either email.  Please see the example that I attached.
Email-Extract-Example.xlsm
0
 
FarWestCommented:
try this, I've tested it and it is ok
' remove ";" from oemails string
'counter ioc  started from 0 not 1
   Dim oEmails() As String
    oEmails = Split("AB_Service_Account@yahoo.com/ABC_CustomerSatisfaction@yahoo.com", "/")
    Dim ioc As Integer
    For ioc = 0 To UBound(oEmails)
    s = Replace(s, oEmails(ioc), "")
    Next

Open in new window

0
 
kbay808Author Commented:
@Rgonzo1971 – I got so excited that your code was doing such a better job extracting all of the emails that I forgot to modify it for exclude the 2 that I did not want.  Your code works perfect!!!  
@FarWest – Your code works perfect too.
Thank you both very much.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.