Run a function

[jempie]

I'm probably missing something really obvious, but I can't see it!!!

I have an email address field in a form. When the user exits the text box, I need an emailaddresscheck function to be run.

Here is the function:

Public Function EmailAddCheck()
Dim blnValid As Boolean
blnValid = True
If Len(EmailAddress.Text) < 6 Then blnValid = False
'checks that e-mail address is more than 6 characters
If InStr(EmailAddress.Text, "@") = 0 Then blnValid = False
'checks for @ in EmailAddressAddress address
If InStr(EmailAddress.Text, ".") = 0 Then blnValid = False
'checks for . in EmailAddress address
If Left(EmailAddress.Text, 1) = "@" Then blnValid = False
'checks that there is a name before the @ sign
If Right(EmailAddress.Text, 1) = "." Then blnValid = False
'checks that there is a destination code in the e-mail address after .
If Not blnValid Then
Cancel = True
'if all appear, then cancel
MsgBox "Invalid Email address, please re-enter."
'if one or more do not appear, display msgbox
End If
End Function


I have then put on the text box exit:

Private Sub EmailAddress_Exit(Cancel As Integer)

Run EmailAddCheck

End Sub

Can anyone please tell me why this does not run?

Thanks

 

[Mile-O]

Firstly, it should go in the BeforeUpdate event - not the Exit event.

And Run is not a Keyword.

Public Function EmailAddCheck()
    Dim blnValid As Boolean
    blnValid = True
    If Len(EmailAddress.Text) < 6 Then blnValid = False
    'checks that e-mail address is more than 6 characters
    If InStr(EmailAddress.Text, "@") = 0 Then blnValid = False
    'checks for @ in EmailAddressAddress address
    If InStr(EmailAddress.Text, ".") = 0 Then blnValid = False
    'checks for . in EmailAddress address
    If Left(EmailAddress.Text, 1) = "@" Then blnValid = False
    'checks that there is a name before the @ sign
    If Right(EmailAddress.Text, 1) = "." Then blnValid = False
    'checks that there is a destination code in the e-mail address after .
    If Not blnValid Then
        Cancel = True
    'if all appear, then cancel
        MsgBox "Invalid Email address, please re-enter."
        'if one or more do not appear, display msgbox
    End If
End Function

This function does not have a Cancel variable/argument so will never work.

I'd suggest using my email validation which is much more indepth.

Open up a new module and paste the code below. Call the module basEmail.

Public Function ValidEmail(ByVal Email As String) As Boolean

    If Not HasNoSpace(Email) Then Exit Function
    If HasNoAt(Email) Then Exit Function
    If HasMultipleAts(Email) Then Exit Function
    If AtBookendsAddress(Email) Then Exit Function
    If Not IsDomain(Mid(Email, InStr(1, Email, "@") + 1)) Then Exit Function
    If DotBookends(Mid(Email, InStr(1, Email, "@") + 1)) Then Exit Function
    If DotBookends(Left(Email, InStr(1, Email, "@") - 1)) Then Exit Function
    If IllegalCharacters(Email) Then Exit Function
    
    ValidEmail = True

End Function

Private Function DotBookends(ByVal strMail As String) As Boolean
    If InStr(1, strMail, ".") = Len(strMail) Or _
        InStr(1, strMail, ".") = 1 Then DotBookends = True
End Function

Private Function IsDomain(ByVal strDomain As String) As Boolean
    If InStr(1, strDomain, ".") > 0 Then IsDomain = True
End Function

Private Function HasNoSpace(ByVal strMail As String) As Boolean
    If InStr(1, strMail, " ") = 0 Then HasNoSpace = True
End Function

Private Function HasNoAt(ByVal strMail As String) As Boolean
    If InStr(1, strMail, "@") = 0 Then HasNoAt = True
End Function

Private Function HasMultipleAts(ByVal strMail As String) As Boolean
    Dim intPosition As Integer
    intPosition = InStr(1, strMail, "@")
    intPosition = InStr(intPosition + 1, strMail, "@")
    If intPosition <> 0 Then HasMultipleAts = True
End Function

Private Function AtBookendsAddress(ByVal strMail As String) As Boolean
    If InStr(1, strMail, "@") = Len(strMail) Or _
        InStr(1, strMail, "@") = 1 Then AtBookendsAddress = True
End Function

Private Function IllegalCharacters(ByVal strMail As String) As Boolean
    Dim intCounter As Integer, intCode As Integer
    strMail = UCase(strMail)
    
    For intCounter = 1 To Len(strMail)
        Select Case Mid(strMail, intCounter, 1)
            Case Is = "!", """", "£", "$", "%", "^", "&", "*", _
                      "(", ")", "+", "=", "/", "\", "<", ">", _
                      ",", ";", ":", "~", "#", "[", "]", _
                      "{", "}", "`", "|"
                IllegalCharacters = True
                Exit Function
        End Select
    Next intCounter
End Function

In your EmailAddress's BeforeUpdate event put the following code:

Private Sub EmailAddress_BeforeUpdate(Cancel As Integer)
    If IsNull(Me.EmailAddress) Then Exit Sub
    If Not ValidEmail(Me.EmailAddress) Then
        MsgBox "Please enter a valid email address.", vbExclamation, "Invalid Email"
        Cancel = True
    End If
End Sub

I'd also recommend you learn to use prefixes for control and object names. In this instance txt for textbox (i.e. txtEmailAddress) so as to disambiguate the textbox from the underlying field - a very good practice to get into.

 

[jempie]

i have just got into vb so i really should learn things like that, thanks!

So I should use str for strings, txt for text boxes etc, yes?

Thanks for the help.

 

[Mile-O]

Yes, makes it easier for you - as the coder - to know what you are referring to and for others, coming to your code, to read and edit.

frm for form
tbl for table
bas for module
cls for Class module
qry for query
rpt for report
txt for textbox
lst for listbox
cbo for combobox
cmd for command button
chk for checkbox
opt for option button
fra for frame
shp for shape
boo for boolean
int for integer
byt for byte
lng for long
sng for single
dte for date
dbl for double
str for string
obj for object
db for database
rs for recordset

and so on.

 

[jempie]

Null

thanks for that, I will make sure i use it in the future!

I've used the above, but if you enter an e-mail address, and then remove it, it returns the invalid email msg box.

 

[Mile-O]

I've just added a line to the BeforeUpdate event. Forgot about it