Test for valid email address

[cebrower]

How can I test for the @ sign when a user enters an email address in a text box in our customer table?

[pbaldy]

The InStr() function can be used for that. I'd probably use something more comprehensive.

[cebrower]

Thanks - I should have thought of that.

[Gicu]

Here is a function I've been using for a long time:

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

Cheers,