[AccessD] email validation

I found this somewhere:

Public Function EMail_Validate_EMailAddr(varEM As Variant) As Boolean
Dim strTmp As String, n As Long, Emsg As String

If SAFEOUTLOOK_RUNTIME Then On Error GoTo EMail_Validate_EMailAddr_Err
EMail_Validate_EMailAddr = False 'default
Emsg = vbNullString
If VarType(varEM) = vbNull Then GoTo EMail_Validate_EMailAddr_Exit
'***************************************************************************
*****
'Validates an email address and returns either True if OK or False if
failed.
'If failed, call the public variable Emsg to see a description of the error
generated
'***************************************************************************
*****

EMail_Validate_EMailAddr = False 'Assume bad on init
n = VarType(varEM)
If n = vbNull Or n <> vbString Then
   Emsg = Emsg & MsgText(6142)
ElseIf InStr(1, varEM, "@") = 0 Then
   Emsg = Emsg & MsgText(6152)
ElseIf InStr(1, varEM, "@") = 1 Then
   Emsg = Emsg & MsgText(6230)
ElseIf InStr(1, varEM, "@") = Len(varEM) Then
   Emsg = Emsg & MsgText(6240)
ElseIf Right(varEM, 4) <> ".com" And Right(varEM, 4) <> ".net" And _
  Right(varEM, 4) <> ".gov" And Right(varEM, 4) <> ".org" And _
  Right(varEM, 3) <> ".us" And Right(varEM, 3) <> ".tv" And _
  Right(varEM, 4) <> ".biz" And Right(varEM, 4) <> ".edu" Then
   Emsg = Emsg & MsgText(6250)
   Emsg = Emsg & vbCrLf & MsgText(6260)
   Emsg = Emsg & vbCrLf & MsgText(6270)
ElseIf Len(varEM) < 6 Then
   Emsg = Emsg & MsgText(6280)
End If
strTmp = varEM
Do While InStr(1, strTmp, "@") <> 0
   n = 1
   strTmp = Right(strTmp, Len(strTmp) - InStr(1, strTmp, "@"))
Loop
If n > 1 Then 'found more than one @ sign
   Emsg = Emsg & ""
End If
If Len(Emsg) Then
    MsgBox Emsg, vbOKOnly Or vbExclamation, MsgText(6290)
    EMail_Validate_EMailAddr = False
Else
    EMail_Validate_EMailAddr = True
End If
GoTo EMail_Validate_EMailAddr_Exit

EMail_Validate_EMailAddr_Err:
MsgBox Err.Description, vbOKOnly Or vbExclamation,
"EMail_Validate_EMailAddr"
EMail_Validate_EMailAddr = False

EMail_Validate_EMailAddr_Exit:
End Function
 


Bruce H. Johnson
Sylmar, CA
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Jim Moss
Sent: Friday, January 06, 2006 8:57 PM
To: accessd at databaseadvisors.com
Subject: [AccessD] email validation

Does anyone have a good email validation module that they would be willing
to share?

Thanks,

Jim

-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com