none
Validating Email address on Access form textbox control RRS feed

  • Question

  • Hello everyone;

    I have an access form and a textbox that takes e-mail address. I need to place a validation on the textbox so that e-mail addresses must contain these synbols. Example: @ . com, net co and so on.

    I have spent hours searxhing the interenet but most of the script don't work or does not contain explanation to applied to  my project.

    Thanks everyone!

    Syn


    • Edited by Synthologic Friday, September 30, 2011 7:11 PM
    Friday, September 30, 2011 6:43 PM

Answers

  • Hi again,

     

    So having the above code placed in Module, you can use the Function PassEmailAddress in your Form.

    This Function checks if the email entered is valid, you can do this by placing the following code in the Before Update event of your TextBox for Email entry:

     

    Private Sub Email_BeforeUpdate(Cancel As Integer)
    
       Dim strMsg As String
       Dim strTxt As String
    
         
         strTxt = Me.Email
               ' check if there is content
             If Len(strTxt) > 0 Then
                ' validate email content
                strMsg = PassEmailAddress(strTxt)
                    If strMsg = Empty Then
                       ' email validation passed
                        Exit sub                       
                        Else
                          ' email validation not passed, show message
                          MsgBox strMsg, vbExclamation, "Validate Email"
                          Cancel = True
                    End If
             End If
    
    End Sub
    

     


    Hope this helps,


    Daniel van den Berg | Washington, USA | "Anticipate the difficult by managing the easy"
    Sunday, October 2, 2011 6:06 AM
    Moderator
  • Hi Syn,

     

    I found these Functions created by Jeanette Cunningham (MVP Access), copy them in New Module into your Access Database and Save it with an unique name.

    You can use these in the Before Update Event of your Textbox you want to Validate.

    -----------------

    Public Function PassEmailAddress(ByVal strEmail As String, _
                        Optional ByRef strReason As String) As String
    On Error GoTo Err_handler
    
        Dim strPrefix As String
        Dim strSuffix As String
        Dim strMiddle As String
        Dim lngCharacter As Long
        Dim strBuffer As String
        Dim blnContinue As String
        Dim strMsg As String
       
        blnContinue = True
        'default = true
       
        strEmail = Trim(strEmail)
       
        If Len(strEmail) < 8 Then
            strReason = "Too short for a valid email address."
            blnContinue = False
        End If
          
        If blnContinue = True Then
            strMsg = CheckAt(strEmail)
            If Len(strMsg) > 0 Then
                blnContinue = False
                strReason = strMsg
            End If
        End If
       
       
        PassEmailAddress = strReason
        
           
        'Dropped through to here, so email address OK
    
    Exit_Handler:
        Exit Function
    Err_handler:
        PassEmailAddress = False
        Debug.Print Err.Number, Err.Description, Now
        Resume Exit_Handler
    
    End Function
    
    Private Function CheckAt(strTxtIn As String) As String
    On Error GoTo Err_handler
    
        Dim lngCharacter As Long
        Dim strMsg As String
        Dim strBuffer As String
        Dim strBuffer2 As String
        Dim strReason As String
        Dim blnContinue As String
       
        blnContinue = True
        'default = true
       
        strBuffer = strTxtIn
        If InStr(strBuffer, "@") = 0 Then
            strReason = "Missing the @ needed in a valid email address."
            blnContinue = False
        End If
       
        If blnContinue = True Then
            If InStr(InStr(strBuffer, "@") + 1, strBuffer, "@") < 0 Then
                strReason = "Too many @ for a valid email address"
                blnContinue = False
            End If
        End If
       
        If blnContinue = True Then
            If InStr(strBuffer, ".") = 0 Then
                strReason = "Missing the period needed in a valid email address."
                blnContinue = False
            End If
        End If
           
        If blnContinue = True Then
            If InStr(strBuffer, "@") = 1 Or InStr(strBuffer, "@") = Len(strBuffer) Or _
                InStr(strBuffer, ".") = 1 Or InStr(strBuffer, ".") = Len(strBuffer) Then
                strReason = "Not a valid format for an email address."
                blnContinue = False
            End If
        End If
          
        On Error Resume Next
        If blnContinue = True Then
            strBuffer = Right(strBuffer, 4)
            If InStr(strBuffer, ".") = 0 Then
                strMsg = TooLong(strBuffer)
                If Len(strMsg) > 0 Then
                    blnContinue = False
                    strReason = strMsg
                End If
            End If
        End If
       
        If blnContinue = True Then
            If Left(strBuffer, 1) = "." Then strBuffer = Right(strBuffer, 3)
            If Left(Right(strBuffer, 3), 1) = "." Then strBuffer = Right(strBuffer, 2)
            If Left(Right(strBuffer, 2), 1) = "." Then strBuffer = Right(strBuffer, 1)
           
            If Len(strBuffer) < 2 Then
                strReason = "Suffix (ending) too short for a valid email address."
                blnContinue = False
            End If
        End If
    
        CheckAt = strReason
       
    Exit_Handler:
        Exit Function
    Err_handler:
        Debug.Print Err.Number, Err.Description, Now
        Resume Exit_Handler
    End Function
    
    Private Function TooLong(strTxtIn As String) As String
    On Error GoTo Err_handler
    
        Dim strReason As String
       
        If Len(strTxtIn) > 3 Then
            strReason = "Suffix (ending) too long for a valid email address."
            TooLong = strReason
        End If
    
    Exit_Handler:
        Exit Function
    Err_handler:
        Debug.Print Err.Number, Err.Description, Now
        Resume Exit_Handler
    End Function
    
    


    Hope this helps,


    Daniel van den Berg | Washington, USA | "Anticipate the difficult by managing the easy"
    Friday, September 30, 2011 8:20 PM
    Moderator

All replies

  • Hi Syn,

     

    I found these Functions created by Jeanette Cunningham (MVP Access), copy them in New Module into your Access Database and Save it with an unique name.

    You can use these in the Before Update Event of your Textbox you want to Validate.

    -----------------

    Public Function PassEmailAddress(ByVal strEmail As String, _
                        Optional ByRef strReason As String) As String
    On Error GoTo Err_handler
    
        Dim strPrefix As String
        Dim strSuffix As String
        Dim strMiddle As String
        Dim lngCharacter As Long
        Dim strBuffer As String
        Dim blnContinue As String
        Dim strMsg As String
       
        blnContinue = True
        'default = true
       
        strEmail = Trim(strEmail)
       
        If Len(strEmail) < 8 Then
            strReason = "Too short for a valid email address."
            blnContinue = False
        End If
          
        If blnContinue = True Then
            strMsg = CheckAt(strEmail)
            If Len(strMsg) > 0 Then
                blnContinue = False
                strReason = strMsg
            End If
        End If
       
       
        PassEmailAddress = strReason
        
           
        'Dropped through to here, so email address OK
    
    Exit_Handler:
        Exit Function
    Err_handler:
        PassEmailAddress = False
        Debug.Print Err.Number, Err.Description, Now
        Resume Exit_Handler
    
    End Function
    
    Private Function CheckAt(strTxtIn As String) As String
    On Error GoTo Err_handler
    
        Dim lngCharacter As Long
        Dim strMsg As String
        Dim strBuffer As String
        Dim strBuffer2 As String
        Dim strReason As String
        Dim blnContinue As String
       
        blnContinue = True
        'default = true
       
        strBuffer = strTxtIn
        If InStr(strBuffer, "@") = 0 Then
            strReason = "Missing the @ needed in a valid email address."
            blnContinue = False
        End If
       
        If blnContinue = True Then
            If InStr(InStr(strBuffer, "@") + 1, strBuffer, "@") < 0 Then
                strReason = "Too many @ for a valid email address"
                blnContinue = False
            End If
        End If
       
        If blnContinue = True Then
            If InStr(strBuffer, ".") = 0 Then
                strReason = "Missing the period needed in a valid email address."
                blnContinue = False
            End If
        End If
           
        If blnContinue = True Then
            If InStr(strBuffer, "@") = 1 Or InStr(strBuffer, "@") = Len(strBuffer) Or _
                InStr(strBuffer, ".") = 1 Or InStr(strBuffer, ".") = Len(strBuffer) Then
                strReason = "Not a valid format for an email address."
                blnContinue = False
            End If
        End If
          
        On Error Resume Next
        If blnContinue = True Then
            strBuffer = Right(strBuffer, 4)
            If InStr(strBuffer, ".") = 0 Then
                strMsg = TooLong(strBuffer)
                If Len(strMsg) > 0 Then
                    blnContinue = False
                    strReason = strMsg
                End If
            End If
        End If
       
        If blnContinue = True Then
            If Left(strBuffer, 1) = "." Then strBuffer = Right(strBuffer, 3)
            If Left(Right(strBuffer, 3), 1) = "." Then strBuffer = Right(strBuffer, 2)
            If Left(Right(strBuffer, 2), 1) = "." Then strBuffer = Right(strBuffer, 1)
           
            If Len(strBuffer) < 2 Then
                strReason = "Suffix (ending) too short for a valid email address."
                blnContinue = False
            End If
        End If
    
        CheckAt = strReason
       
    Exit_Handler:
        Exit Function
    Err_handler:
        Debug.Print Err.Number, Err.Description, Now
        Resume Exit_Handler
    End Function
    
    Private Function TooLong(strTxtIn As String) As String
    On Error GoTo Err_handler
    
        Dim strReason As String
       
        If Len(strTxtIn) > 3 Then
            strReason = "Suffix (ending) too long for a valid email address."
            TooLong = strReason
        End If
    
    Exit_Handler:
        Exit Function
    Err_handler:
        Debug.Print Err.Number, Err.Description, Now
        Resume Exit_Handler
    End Function
    
    


    Hope this helps,


    Daniel van den Berg | Washington, USA | "Anticipate the difficult by managing the easy"
    Friday, September 30, 2011 8:20 PM
    Moderator
  • Hi Syn,

     

    I found these Functions created by Jeanette Cunningham (MVP Access), copy them in New Module into your Access Database and Save it with an unique name.

    You can use these in the Before Update Event of your Textbox you want to Validate.

    -----------------

     

    Public Function PassEmailAddress(ByVal strEmail As String, _
    Optional ByRef strReason As String) As String
    On Error GoTo Err_handler

    Dim strPrefix As String
    Dim strSuffix As String
    Dim strMiddle As String
    Dim lngCharacter As Long
    Dim strBuffer As String
    Dim blnContinue As String
    Dim strMsg As String

    blnContinue = True
    'default = true

    strEmail = Trim(strEmail)

    If Len(strEmail) < 8 Then
    strReason = "Too short for a valid email address."
    blnContinue = False
    End If

    If blnContinue = True Then
    strMsg = CheckAt(strEmail)
    If Len(strMsg) > 0 Then
    blnContinue = False
    strReason = strMsg
    End If
    End If


    PassEmailAddress = strReason


    'Dropped through to here, so email address OK

    Exit_Handler:
    Exit Function
    Err_handler:
    PassEmailAddress = False
    Debug.Print Err.Number, Err.Description, Now
    Resume Exit_Handler

    End Function

    Private Function CheckAt(strTxtIn As String) As String
    On Error GoTo Err_handler

    Dim lngCharacter As Long
    Dim strMsg As String
    Dim strBuffer As String
    Dim strBuffer2 As String
    Dim strReason As String
    Dim blnContinue As String

    blnContinue = True
    'default = true

    strBuffer = strTxtIn
    If InStr(strBuffer, "@") = 0 Then
    strReason = "Missing the @ needed in a valid email address."
    blnContinue = False
    End If

    If blnContinue = True Then
    If InStr(InStr(strBuffer, "@") + 1, strBuffer, "@") < 0 Then
    strReason = "Too many @ for a valid email address"
    blnContinue = False
    End If
    End If

    If blnContinue = True Then
    If InStr(strBuffer, ".") = 0 Then
    strReason = "Missing the period needed in a valid email address."
    blnContinue = False
    End If
    End If

    If blnContinue = True Then
    If InStr(strBuffer, "@") = 1 Or InStr(strBuffer, "@") = Len(strBuffer) Or _
    InStr(strBuffer, ".") = 1 Or InStr(strBuffer, ".") = Len(strBuffer) Then
    strReason = "Not a valid format for an email address."
    blnContinue = False
    End If
    End If

    On Error Resume Next
    If blnContinue = True Then
    strBuffer = Right(strBuffer, 4)
    If InStr(strBuffer, ".") = 0 Then
    strMsg = TooLong(strBuffer)
    If Len(strMsg) > 0 Then
    blnContinue = False
    strReason = strMsg
    End If
    End If
    End If

    If blnContinue = True Then
    If Left(strBuffer, 1) = "." Then strBuffer = Right(strBuffer, 3)
    If Left(Right(strBuffer, 3), 1) = "." Then strBuffer = Right(strBuffer, 2)
    If Left(Right(strBuffer, 2), 1) = "." Then strBuffer = Right(strBuffer, 1)

    If Len(strBuffer) < 2 Then
    strReason = "Suffix (ending) too short for a valid email address."
    blnContinue = False
    End If
    End If

    CheckAt = strReason

    Exit_Handler:
    Exit Function
    Err_handler:
    Debug.Print Err.Number, Err.Description, Now
    Resume Exit_Handler
    End Function

    Private Function TooLong(strTxtIn As String) As String
    On Error GoTo Err_handler

    Dim strReason As String

    If Len(strTxtIn) > 3 Then
    strReason = "Suffix (ending) too long for a valid email address."
    TooLong = strReason
    End If

    Exit_Handler:
    Exit Function
    Err_handler:
    Debug.Print Err.Number, Err.Description, Now
    Resume Exit_Handler
    End Function



     

    Hope this helps,


    Daniel van den Berg | Washington, USA | "Anticipate the difficult by managing the easy"

    Thanks for your help.
    Here is the problem, in my form or database, email address is not required, I only want to check for a valid email address when a value or address has been entered into the e-mail filed. Example: If e-mail is not empty or if emial has a value, then check for the follow elements. If e-mail is empty is empty, do not look for anything, move on.

    Any ideas?

     

    Thanks again!

    SYN

    Sunday, October 2, 2011 1:56 AM
  • Hi again,

     

    So having the above code placed in Module, you can use the Function PassEmailAddress in your Form.

    This Function checks if the email entered is valid, you can do this by placing the following code in the Before Update event of your TextBox for Email entry:

     

    Private Sub Email_BeforeUpdate(Cancel As Integer)
    
       Dim strMsg As String
       Dim strTxt As String
    
         
         strTxt = Me.Email
               ' check if there is content
             If Len(strTxt) > 0 Then
                ' validate email content
                strMsg = PassEmailAddress(strTxt)
                    If strMsg = Empty Then
                       ' email validation passed
                        Exit sub                       
                        Else
                          ' email validation not passed, show message
                          MsgBox strMsg, vbExclamation, "Validate Email"
                          Cancel = True
                    End If
             End If
    
    End Sub
    

     


    Hope this helps,


    Daniel van den Berg | Washington, USA | "Anticipate the difficult by managing the easy"
    Sunday, October 2, 2011 6:06 AM
    Moderator
  • Old thread, I know, but I ran into this as well when using the above code in a form that has multiple email address boxes, not all of which are required to be filled.  New coder here, so this may be a silly thing to do, but this got around null values in the field for me:

    Adding the line 

    if isnull(email) = true then exit sub

    before line 

    strtxt = me.email


    Boyd

    Thursday, November 27, 2014 4:57 PM
  • Works perfectly, thank you to all developers involved in creating this discussion

    Claude


    Claude Larocque

    Thursday, April 7, 2016 4:18 AM