Find Email
In this article I am doing a simple PoC, by building a solution for the users who wants to extract email from a string. Following a common function which can be called through any office interface (supports VBA) to extract email from a string.
Code example
Public Function FindEmail(strSource As String) As String
FindEmail = ""
On Error GoTo errh
'Validate empty string
If IsEmpty(strSource) = False And Len(strSource) > 0 Then
'check if string contains @
If InStr(1, strSource, "@") > 0 Then
Dim objEmail
objEmail = Split(strSource, " ")
Dim oElement
For Each oElement In objEmail
If InStr(1, oElement, "@") > 0 Then
Dim startPos As Integer
startPos = InStr(1, oElement, "@")
Dim lastPart As String
lastPart = Mid(oElement, startPos, Len(oElement) - startPos)
'Check dot
If InStr(1, lastPart, ".") > 0 Then
FindEmail = Trim(oElement)
Exit Function
End If
End If
Next oElement
Set oElement = Nothing
Else
FindEmail = "does not contain email"
Exit Function
End If
Else
FindEmail = "Please enter a valid string"
Exit Function
End If
errh:
If Err.Number <> 0 Then
FindEmail = Err.Description
Exit Function
End If
End Function
Explanation
The above function can be modified to fit in your need. The function takes a string parameter as input and looks for a valid email, if found it will return email address else blank or respective error.
Implementation
Output
