CodeItBetter Programming Another VB Programming Blog

'String Manipulation - How to Check an Email Address for Validity (VB.NET and VB6) (in two ways)
'This function, which works in VB5, VB6, and VB.NET will allow you to call
'CheckEmail("someone@mydomain.com") to see if:

'    * It doesn't contain invalid characters.
'    * Doesn't have more than one @.
'    * Has some text prior to the @.
'    * Has some text after the @.
'    * Has text between the @ and the "."
'    * Has text after the last "."

'Method 1:

Public Function ValidEmail(ByVal strCheck As String) As Boolean
    Dim bCK As Boolean
    Dim strDomainType As String
    Dim strDomainName As String
    Const sInvalidChars As String = "!#$%^&*()=+{}[]|\;:'/?>,< "
    Dim i As Integer
 
    bCK = Not InStr(1, strCheck,  chr ( 34)) > 0    'Check to see if there is a double quote
    If Not bCK Then GoTo ExitFunction
 
    bCK = Not InStr(1, strCheck, "..") > 0    'Check to see if there are consecutive dots
    If Not bCK Then GoTo ExitFunction
 
    ' Check for invalid characters.
    If Len(strCheck) > Len(sInvalidChars) Then
        For i = 1 To Len(sInvalidChars)
            If InStr(strCheck, Mid(sInvalidChars, i, 1)) > 0 Then
                bCK = False
                GoTo ExitFunction
            End If
        Next
    Else
        For i = 1 To Len(strCheck)
            If InStr(sInvalidChars, Mid(strCheck, i, 1)) > 0 Then
                bCK = False
                GoTo ExitFunction
            End If
        Next
    End If
 
    If InStr(1, strCheck, "@") > 1 Then    'Check for an @ symbol
        bCK = Len(Left(strCheck, InStr(1, strCheck, "@") - 1)) > 0
    Else
        bCK = False
    End If
    If Not bCK Then GoTo ExitFunction
 
    strCheck = Right(strCheck, Len(strCheck) - InStr(1, strCheck, "@"))
    bCK = Not InStr(1, strCheck, "@") > 0    'Check to see if there are too many @'s
    If Not bCK Then GoTo ExitFunction
 
    strDomainType = Right(strCheck, Len(strCheck) - InStr(1, strCheck, "."))
    bCK = Len(strDomainType) > 0 And InStr(1, strCheck, ".") < Len(strCheck)
    If Not bCK Then GoTo ExitFunction
 
    strCheck = Left(strCheck, Len(strCheck) - Len(strDomainType) - 1)
    Do Until InStr(1, strCheck, ".") <= 1
        If Len(strCheck) >= InStr(1, strCheck, ".") Then
            strCheck = Left(strCheck, Len(strCheck) - (InStr(1, strCheck, ".") - 1))
        Else
            bCK = False
            GoTo ExitFunction
        End If
    Loop
    If strCheck = "." Or Len(strCheck) = 0 Then bCK = False
 
ExitFunction:
    ValidEmail = bCK
End Function
 
'Method 2 (Using Regular Expressions):

Option Explicit
 
'Add one Text box (Text1) and a command box (Command1).
'Enter valid email id on text1 and click on command1.
'Capital letters are considered as invalid

'Use the Project -> References in VB6 to reference the library and select
'Microsoft VBScript Regular Expressions 5.5

Private Sub Command1_Click()
    Const FORMAT_1 = "^[a-z0-9._%-]+@[a-z0-9.-]+\.[a-z]{2,4}$"
    Dim regXYZ As RegExp
    Set regXYZ = New RegExp    ' establish the expression
    With regXYZ
        .Pattern = FORMAT_1    ' set the .Pattern
        If .Test(Text1) Then    ' test to see if the pattern is present
            ' got a match so FORMAT_1 is the pattern
            MsgBox "Match."
        Else
            MsgBox "Did not match."
        End If
    End With
    Set regXYZ = Nothing
End Sub