验证E-Mail地址的正确性

来源：作者：出处：巧巧读书 2006-11-20 进入讨论组

关键词：

谢谢收藏 http://www.qqread.com/vb/b279018.html
　　Validate an E-Mail Address

Need to ensure an e-mail address is valid?

This copy-and-paste code snippet checks an address for its length, the @ sign, the period, the characters used, the suffix ?and more!

Save your overworked fingers further strain and add this snippet to your code library.

To use it, simply call the IsEMailAddress function, passing in an e-mail address and an optional 注释：reason注释： string variable. The procedure will return a True if the e-mail address is valid, a False otherwise.

If False is returned, the reason for its failure will be passed back into the optional reason string.

With thanks to Paul Brown for the code base (slightly revised for publication).

Usage

Dim IsValid As Boolean
Dim InvalidReason As String

IsValid = IsEMailAddress("karl@karlmoore.com", InvalidReason)

MsgBox "Is the e-mail address valid? - " & IsValid

MsgBox "If invalid, the reason given is: " & InvalidReasonCode

Public Function IsEMailAddress(ByVal sEmail As String, _
    Optional ByRef sReason As String) As Boolean

Dim sPreffix As String
Dim sSuffix As String
Dim sMiddle As String
Dim nCharacter As Integer
Dim sBuffer As String

sEmail = Trim(sEmail)

If Len(sEmail) < 8 Then
IsEMailAddress = False
sReason = "Too short"
Exit Function
End If

If InStr(sEmail, "@") = 0 Then
IsEMailAddress = False
sReason = "Missing the @"
Exit Function
End If

If InStr(InStr(sEmail, "@") + 1, sEmail, "@") <> 0 Then
IsEMailAddress = False
sReason = "Too many @"
Exit Function
End If

If InStr(sEmail, ".") = 0 Then
IsEMailAddress = False
sReason = "Missing the period"
Exit Function
End If

If InStr(sEmail, "@") = 1 Or InStr(sEmail, "@") = Len(sEmail) Or _
InStr(sEmail, ".") = 1 Or InStr(sEmail, ".") = Len(sEmail) Then
IsEMailAddress = False
sReason = "Invalid format"
Exit Function

End If

For nCharacter = 1 To Len(sEmail)
sBuffer = Mid$(sEmail, nCharacter, 1)
If Not (LCase(sBuffer) Like "[a-z]" Or sBuffer = "@" Or _
sBuffer = "." Or sBuffer = "-" Or sBuffer = "_" Or _
IsNumeric(sBuffer)) Then: IsEMailAddress = _
False: sReason = "Invalid character": Exit Function
Next nCharacter

nCharacter = 0

On Error Resume Next

sBuffer = Right(sEmail, 4)
If InStr(sBuffer, ".") = 0 Then GoTo TooLong:
If Left(sBuffer, 1) = "." Then sBuffer = Right(sBuffer, 3)
If Left(Right(sBuffer, 3), 1) = "." Then sBuffer = Right(sBuffer, 2)
If Left(Right(sBuffer, 2), 1) = "." Then sBuffer = Right(sBuffer, 1)

If Len(sBuffer) < 2 Then
IsEMailAddress = False
sReason = "Suffix too short"
Exit Function
End If

TooLong:

If Len(sBuffer) > 3 Then
IsEMailAddress = False
sReason = "Suffix too long"
Exit Function
End If

sReason = Empty
IsEMailAddress = True

End Function进入讨论组讨论。