Validate E-mail Addresses

Problem: Imagine you've a large database of email-addresses or you copied a web page containing e-mail addresses and other unnecessary text and you want to highlight valid or extract valid E-mail addresses from them.

Solution:
Rules:
i) As per the problem, designing a function(UDF) would be the best approach as it can be used in worksheet as well as sub-routines.
ii) Since it's a email address, @ must appear exactly once.
iii) It must only contain alphanumeric set, underscore(_),hyphen or dash(-) and period/dot(.)
iv) Leftmost and Rightmost character should not be .
v) Period/dot (.) must appear at least once after the @.
vi) There should be either 2 or 3 characters(eg. com, net, org, in, us, uk etc) after the last period (.)
vii) There must be at least one alphanumeric character before @

Function Code:

Function CheckEmail(ByVal EmailAddress As String)
Dim sArray As Variant, sItem As Variant
Dim n As Long, c As String
'Find the number of @, it should be exactly one.
n = Len(EmailAddress) - Len(Application.Substitute(EmailAddress, "@", ""))
If n <> 1 Then CheckEmail = False: Exit Function
ReDim sArray (1 To 2)
sArray (1) = Left(EmailAddress, InStr(1, EmailAddress, "@", 1) - 1)
sArray (2) = Application.Substitute(Right(EmailAddress, Len(EmailAddress ) - Len(sArray(1))), "@", "")
For Each sItem In sArray
'There should be atleast one character before @.
If Len(sItem) <= 0 Then CheckEmail = False: Exit Function
For n = 1 To Len(sItem)
  c = LCase(Mid(sItem, n, 1))
                           'It must not contain any special character but only alphanumeric, underscore, period and dash or hyphen.
If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c)  Then CheckEmail = False: Exit Function
Next
'Extreme characters must not be period or dot (.)
If Left(sItem, 1) = "." Or Right(sItem, 1) = "."  Then CheckEmail = False: Exit Function
Next
'There must be atleast one period or dot after @
If InStr(sArray(2), ".") <= 0  Then CheckEmail = False: Exit Function
'After the last dot or period, there must be either exactly 2 or 3 characters.
n = Len(sArray(2)) - InStrRev(sArray(2), ".")
If n <> 2 And n <> 3  Then CheckEmail = False: Exit Function
'It must not contain 2 or more consecutive periods or dots.
If InStr(EmailAddress, "..") > 0  Then CheckEmail = False: Exit Function
CheckEmail = True
End Function

---