The following code will see if the user has enterd a valid e-mail address (format wise, not if it actually exists). It's a bit overkill for many people, but it covers a lot of possibilities, and allows for expansion.

Other posts exist in the General topic for e-mail validation, however, this post is more non-specific.

'==== USAGE ==== Private Sub ValidateEMail(byval EmailAddress as String)     Dim EMail As New CEmail     Dim Ret As eEMailValid ' Use the below to test it, uncomment obviously ' EmailAddress = "Test@host.com"          Set EMail = New CEmail          With EMail         .IndividualFieldBadCharCheck = True         .MaxExtensionLength = 3         Ret = .IsValidEMail(EmailAddress)         If Ret = EV_VALID Then             MsgBox "Valid!"         Else             MsgBox .ErrorNumberToText(Ret)         End If     End With          Set EMail = Nothing End Sub '==== In a CLASS MODULE ==== '/************************************ ' * Validate E-Mail, (proper syntax) * ' */********************************** ' Valid E-Mail: '    characters allowed on '        name: any not in exclusion '0-9a-Z-._ '        host: any not in exclusion '0-9a-Z-. '        extension: any not in exclusion '    must start or end with alpha or num '    name must end with alpha or num '    host must start with alpha or num '    pair .- or -. or -- or .. not allowed '    pair ._ or -_ or _. or _- or __ not allowed '    host must end with '.' plus 2 or 3 alpha ' Checking Priority (most likely error to least): '    Data not null '    Total E-Mail proper length '    Syntax (EX: xxx@xxx.xxx) '    Field Lengths '    Valid Characters '    Valid Pairs ' NOTE: '    Most (to all) routines check the error status '    before continuing. If 1 step fails, no others '    will be run. '    Routine will only return 1 error for the provided '    E-Mail address. Public Enum eEMailValid     EV_VALID     EV_MISSINGAT     EV_MISSINGPERIOD     EV_TOOSHORT     EV_TOOSHORT_USERNAME     EV_TOOSHORT_DOMAIN     EV_TOOSHORT_EXTENSION     EV_TOOLONG     EV_TOOLONG_USERNAME     EV_TOOLONG_DOMAIN     EV_TOOLONG_EXTENSION     EV_INVALID_CHARS     EV_INVALID_PAIRS     EV_INVALID_NAME_STARTINGCHAR     EV_INVALID_NAME_ENDINGCHAR     EV_INVALID_DOMAIN_STARTINGCHAR     EV_INVALID_DOMAIN_ENDINGCHAR     EV_INVALID_EXT_STARTINGCHAR     EV_INVALID_EXT_ENDINGCHAR     EV_NODATA     EV_MAXERRORS End Enum Private Const INVALIDCHARSLIST = "`~!#$%^&*()+={}[]|;':,/<>? " Private Const INVALIDPAIRSLIST = ".-;-.;--;..;@@;._;-_;_.;_-;__;" Private Const VALIDHOST = ".com;.net;.gov;.org;.tv;.biz" Private Type tMinMax     iMin As Integer     iMax As Integer End Type Private Type tEmailFields     UserName As String     Domain As String     Extension As String End Type Private Type tInvalidChars     EntireEmail As String     IndividualFields As tEmailFields     CheckForIndividual As Boolean     InvalidPairs As String End Type Private Type tEMail     InvalidChars As tInvalidChars     EmailLength As tMinMax     UserNameLength As tMinMax     DomainLength As tMinMax     ExtensionLength As tMinMax End Type Private EMailParams As tEMail Private EMailFields As tEmailFields Private EMailErrorCode() As String Option Explicit ' /****************************** '  * Email Lengths              * '  */**************************** Public Property Let MaxEmailLength(ByVal Value As Integer)     EMailParams.EmailLength.iMax = Value End Property Public Property Get MaxEmailLength() As Integer     MaxEmailLength = EMailParams.EmailLength.iMax End Property Public Property Let MinEmailLength(ByVal Value As Integer)     EMailParams.EmailLength.iMin = Value End Property Public Property Get MinEmailLength() As Integer     MinEmailLength = EMailParams.EmailLength.iMin End Property ' /****************************** '  * UserName Lengths           * '  */**************************** Public Property Let MaxUserNameLength(ByVal Value As Integer)     EMailParams.UserNameLength.iMax = Value End Property Public Property Get MaxUserNameLength() As Integer     MaxUserNameLength = EMailParams.UserNameLength.iMax End Property Public Property Let MinUserNameLength(ByVal Value As Integer)     EMailParams.UserNameLength.iMin = Value End Property Public Property Get MinUserNameLength() As Integer     MinUserNameLength = EMailParams.UserNameLength.iMin End Property ' /****************************** '  * Extension Lengths          * '  */**************************** Public Property Let MaxExtensionLength(ByVal Value As Integer)     EMailParams.ExtensionLength.iMax = Value End Property Public Property Get MaxExtensionLength() As Integer     MaxExtensionLength = EMailParams.ExtensionLength.iMax End Property Public Property Let MinExtensionLength(ByVal Value As Integer)     EMailParams.ExtensionLength.iMin = Value End Property Public Property Get MinExtensionLength() As Integer     MinExtensionLength = EMailParams.ExtensionLength.iMin End Property ' /****************************** '  * Domain Lengths             * '  */**************************** Public Property Let MaxDomainLength(ByVal Value As Integer)     EMailParams.DomainLength.iMax = Value End Property Public Property Get MaxDomainLength() As Integer     MaxDomainLength = EMailParams.DomainLength.iMax End Property Public Property Let MinDomainLength(ByVal Value As Integer)     EMailParams.DomainLength.iMin = Value End Property Public Property Get MinDomainLength() As Integer     MinDomainLength = EMailParams.DomainLength.iMin End Property ' /****************************** '  * Bad Characters Checking    * '  */**************************** Public Property Let IndividualFieldBadCharCheck(ByVal Value As Boolean)     EMailParams.InvalidChars.CheckForIndividual = Value End Property Public Property Get IndividualFieldBadCharCheck() As Boolean     IndividualFieldBadCharCheck = EMailParams.InvalidChars.CheckForIndividual End Property Public Property Let InvalidChars_EntireAddress(ByVal Value As String)     EMailParams.InvalidChars.EntireEmail = Value End Property Public Property Get InvalidChars_EntireAddress() As String     InvalidChars_EntireAddress = EMailParams.InvalidChars.EntireEmail End Property Public Property Let InvalidChars_UserName(ByVal Value As String)     EMailParams.InvalidChars.IndividualFields.UserName = Value End Property Public Property Get InvalidChars_UserName() As String     InvalidChars_UserName = EMailParams.InvalidChars.IndividualFields.UserName End Property Public Property Let InvalidChars_DomainName(ByVal Value As String)     EMailParams.InvalidChars.IndividualFields.Domain = Value End Property Public Property Get InvalidChars_DomainName() As String     InvalidChars_DomainName = EMailParams.InvalidChars.IndividualFields.Domain End Property Public Property Let InvalidChars_ExtensionName(ByVal Value As String)     EMailParams.InvalidChars.IndividualFields.Extension = Value End Property Public Property Get InvalidChars_ExtensionName() As String     InvalidChars_ExtensionName = EMailParams.InvalidChars.IndividualFields.Extension End Property Public Property Let InvalidChars_InvalidPairs(ByVal Value As String)     Dim sSeparator As String     If InStr(1, Value, ";") > 0 Then         EMailParams.InvalidChars.InvalidPairs = Value     Else         sSeparator = Mid(Value, 3, 1)         EMailParams.InvalidChars.InvalidPairs = Replace(Value, sSeparator, ";")     End If End Property Public Property Get InvalidChars_InvalidPairs() As String     InvalidChars_InvalidPairs = EMailParams.InvalidChars.InvalidPairs End Property ' /****************************** '  * Checking routines          * '  */**************************** Public Function IsValidEMail(ByVal EMail As String) As eEMailValid     Dim Errors As eEMailValid     Dim iLen As Integer          Errors = EV_VALID      ' First check for data     If LenB(EMail) > 0 Then     ' Check length of address         Errors = ValidEMailLength(EMail)         If Errors = EV_VALID Then         ' Check for proper syntax xxx@xxx.xxx             Errors = ValidSyntax(EMail)             If Errors = EV_VALID Then             ' Make sure field lengths are proper                 Errors = ValidFieldLength(EMail)                 If Errors = EV_VALID Then                 ' Make sure valid chars are entered                     Errors = ValidChars(EMail)                     If Errors = EV_VALID Then                     ' Make sure no invalid pairs                         Errors = ValidPairs(EMail)                     End If                 End If             End If         End If     Else         Errors = EV_NODATA     End If     IsValidEMail = Errors End Function Public Function ErrorNumberToText(ByVal ErrorCode As eEMailValid) As String     ErrorNumberToText = EMailErrorCode(ErrorCode) End Function Private Function ValidFieldLength(ByVal Value As String) As eEMailValid     Dim Errors As eEMailValid     Dim iTmp As Integer     Dim iMin As Integer     Dim iMax As Integer          Errors = EV_VALID          With EMailParams     ' UserName         iTmp = Len(EMailFields.UserName)     '-1 means don't check, can't be smaller than, but can larger         iMin = .UserNameLength.iMin         iMax = .UserNameLength.iMax                  If iTmp < iMin Then             Errors = EV_TOOSHORT_USERNAME         ElseIf iTmp > iMax And iMax > -1 Then             Errors = EV_TOOLONG_USERNAME         End If              If Errors = EV_VALID Then         ' Domain             iTmp = Len(EMailFields.Domain)         '-1 means don't check, can't be smaller than, but can larger             iMin = .DomainLength.iMin             iMax = .DomainLength.iMax                          If iTmp < iMin Then                 Errors = EV_TOOSHORT_DOMAIN             ElseIf iTmp > iMax And iMax > -1 Then                 Errors = EV_TOOLONG_DOMAIN             End If                                  If Errors = EV_VALID Then             ' Extension                 iTmp = Len(EMailFields.Extension)             '-1 means don't check, can't be smaller than, but can larger                 iMin = .ExtensionLength.iMin                 iMax = .ExtensionLength.iMax                                  If iTmp < iMin Then                     Errors = EV_TOOSHORT_EXTENSION                 ElseIf iTmp > iMax And iMax > -1 Then                     Errors = EV_TOOLONG_EXTENSION                 End If             End If         End If     End With          ValidFieldLength = Errors End Function Private Function ValidPairs(ByVal Value As String) As eEMailValid     Dim Errors As eEMailValid     Dim sPairs() As String     Dim i As Integer          Errors = EV_VALID          sPairs = Split(EMailParams.InvalidChars.InvalidPairs, ";")          If LBound(sPairs()) < UBound(sPairs()) Then         i = LBound(sPairs())         Do             If InStr(1, Value, sPairs(i)) > 0 Then                 Errors = EV_INVALID_PAIRS             End If             i = i + 1         Loop Until i = UBound(sPairs()) Or Errors = EV_INVALID_PAIRS     End If          ValidPairs = Errors End Function Private Function ValidEMailLength(ByVal Value As String) As eEMailValid ' This routine will check the total length     Dim i As Integer     Dim Errors As eEMailValid          Errors = EV_VALID          i = Len(Value)      ' Verify Total address length     If i < EMailParams.EmailLength.iMin Then         Errors = EV_TOOSHORT     ElseIf i > EMailParams.EmailLength.iMax Then         Errors = EV_TOOLONG     End If     ValidEMailLength = Errors End Function Private Function ValidSyntax(ByVal Value As String) As eEMailValid     Dim Errors As eEMailValid     Dim iAt As Integer     Dim iPeriod As Integer          Errors = EV_VALID          iAt = InStr(1, Value, "@")     If iAt > 0 Then         If InStr(iAt + 1, Value, "@") > 0 Then             Errors = EV_INVALID_CHARS         Else             iPeriod = InStr(iAt, Value, ".")             If iPeriod = 0 Then                 Errors = EV_MISSINGPERIOD             Else             ' Since we have the positions, store the address                 EMailFields.UserName = Left(Value, iAt - 1)                 EMailFields.Domain = Mid(Value, iAt + 1, iPeriod - iAt - 1)                 EMailFields.Extension = Right(Value, Len(Value) - iPeriod)             End If         End If     Else         Errors = EV_MISSINGAT     End If          ValidSyntax = Errors End Function Private Function ValidChars(ByVal Value As String) As eEMailValid     Dim Errors As eEMailValid     Dim i As Integer     Dim fInvalidChars As Boolean          Errors = EV_VALID ' Check for first/last characters as characters     If Not IsChar(Left(EMailFields.UserName, 1)) Then         Errors = EV_INVALID_NAME_STARTINGCHAR '    ElseIf Not IsChar(Right(EMailFields.UserName, 1)) Then '        Errors = EV_INVALID_NAME_ENDINGCHAR     ElseIf Not IsChar(Left(EMailFields.Domain, 1)) Then         Errors = EV_INVALID_DOMAIN_STARTINGCHAR '    ElseIf Not IsChar(Right(EMailFields.Domain, 1)) Then '        Errors = EV_INVALID_DOMAIN_ENDINGCHAR     ElseIf Not IsChar(Left(EMailFields.Extension, 1)) Then         Errors = EV_INVALID_EXT_STARTINGCHAR '    ElseIf Not IsChar(Right(EMailFields.Extension, 1)) Then '        Errors = EV_INVALID_EXT_ENDINGCHAR     Else     ' Everything's ok so far... Now check the contents         i = 1         fInvalidChars = False         If EMailParams.InvalidChars.CheckForIndividual = False Then         ' Check entire address for invalid chars             fInvalidChars = InvalidChars(Value, EMailParams.InvalidChars.EntireEmail)         Else         ' Check individual fields for invalid chars             fInvalidChars = InvalidChars(EMailFields.UserName, EMailParams.InvalidChars.IndividualFields.UserName)             If Not fInvalidChars Then                 fInvalidChars = InvalidChars(EMailFields.Domain, EMailParams.InvalidChars.IndividualFields.Domain)                 If Not fInvalidChars Then                     fInvalidChars = InvalidChars(EMailFields.Extension, EMailParams.InvalidChars.IndividualFields.Extension)                 End If             End If         End If         If fInvalidChars Then             Errors = EV_INVALID_CHARS         End If     End If          ValidChars = Errors End Function Private Function InvalidChars(ByVal CheckIn As String, ByVal CheckForList As String) As Boolean     Dim i As Integer     Dim fInvalidChars As Boolean          fInvalidChars = False          If LenB(CheckForList) > 0 Then         i = 1                  Do             If InStr(1, CheckIn, Mid(CheckForList, i, 1)) > 0 Then                 fInvalidChars = True             End If             i = i + 1         Loop Until i > Len(CheckForList) Or fInvalidChars     End If          InvalidChars = fInvalidChars End Function Private Function IsChar(ByVal Value As String) As Boolean ' For simplicity, it uses the IsNumeric function     Dim i As Integer     Dim fIsChar As Boolean          i = 1          fIsChar = True          Do         fIsChar = Not IsNumeric(Mid(Value, i, 1))         i = i + 1     Loop Until i >= Len(Value) Or fIsChar = False          IsChar = fIsChar End Function Private Sub Class_Initialize() ' Setup the starting (default) values     With EMailParams         .InvalidChars.InvalidPairs = INVALIDPAIRSLIST         .InvalidChars.CheckForIndividual = False         .InvalidChars.EntireEmail = INVALIDCHARSLIST         .InvalidChars.IndividualFields.UserName = INVALIDCHARSLIST         .InvalidChars.IndividualFields.Domain = INVALIDCHARSLIST         .InvalidChars.IndividualFields.Extension = INVALIDCHARSLIST         .DomainLength.iMin = 1         .DomainLength.iMax = 255         .EmailLength.iMin = 5         .EmailLength.iMax = 255         .ExtensionLength.iMin = 2         .ExtensionLength.iMax = 4         .UserNameLength.iMin = 1         .UserNameLength.iMax = 255     End With          ReDim EMailErrorCode(EV_MAXERRORS)     EMailErrorCode(EV_VALID) = "Valid"     EMailErrorCode(EV_MISSINGAT) = "Missing '@'"     EMailErrorCode(EV_MISSINGPERIOD) = "Missing '.'"     EMailErrorCode(EV_TOOSHORT) = "Too Short"     EMailErrorCode(EV_TOOSHORT_USERNAME) = "Username Too Short"     EMailErrorCode(EV_TOOSHORT_DOMAIN) = "Domain Too Short"     EMailErrorCode(EV_TOOSHORT_EXTENSION) = "Extension Too Short"     EMailErrorCode(EV_TOOLONG) = "Too Long"     EMailErrorCode(EV_TOOLONG_USERNAME) = "Username Too Long"     EMailErrorCode(EV_TOOLONG_DOMAIN) = "Domain Too Long"     EMailErrorCode(EV_TOOLONG_EXTENSION) = "Extension Too Long"     EMailErrorCode(EV_INVALID_CHARS) = "Invalid Characters"     EMailErrorCode(EV_INVALID_PAIRS) = "Invalid Pairs (EX: , @@)"     EMailErrorCode(EV_INVALID_NAME_STARTINGCHAR) = "Invalid Name Starting Character"     EMailErrorCode(EV_INVALID_NAME_ENDINGCHAR) = "Incalid Name Ending Character"     EMailErrorCode(EV_INVALID_DOMAIN_STARTINGCHAR) = "Invalid Domain Starting Character"     EMailErrorCode(EV_INVALID_DOMAIN_ENDINGCHAR) = "Invalid Domain Ending Character"     EMailErrorCode(EV_INVALID_EXT_STARTINGCHAR) = "Invalid Extension Starting Character"     EMailErrorCode(EV_INVALID_EXT_ENDINGCHAR) = "Invalid Extension Ending Character"     EMailErrorCode(EV_NODATA) = "No Data sent - EMail address NULL" End Sub Private Sub Class_Terminate()     Erase EMailErrorCode End Sub

[Edited by JLRodgers on 11-03-2003 at 01:57 PM GMT]

____________________________
Everywhere's Local (classifieds, job postings, & more for everycity in the world - user entered)