Code following to know the validity of e-mail:

Function IsValidEmail(sEMail As String) As Boolean

' original by Brad Murray

' optimized by Rob Hofker, email: rob@eurocamp.nl,

'23 august 2000

Dim sInvalidChars As String

Dim bTemp As Boolean

Dim i As Integer

Dim sTemp As String

' Disallowed characters

sInvalidChars = "!#$%^&*()=+{}[]|\;:'/?>,< "

' Check that there is at least one '@'

bTemp = InStr(sEMail, "@") <= 0

If bTemp Then GoTo exit_function

' Check that there is at least one '.'

bTemp = InStr(sEMail, ".") <= 0

If bTemp Then GoTo exit_function

' and that the length is at least six (a@a.ca)

bTemp = Len(sEMail) < 6

If bTemp Then GoTo exit_function

' Check that there is only one '@'

i = InStr(sEMail, "@")

sTemp = Mid(sEMail, i + 1)

bTemp = InStr(sTemp, "@") > 0

If bTemp Then GoTo exit_function

'extra checks

' AFTER '@' space is not allowed

bTemp = InStr(sTemp, " ") > 0

If bTemp Then GoTo exit_function

' Check that there is one dot AFTER '@'

bTemp = InStr(sTemp, ".") = 0

If bTemp Then GoTo exit_function

' Check if there's a quote (")

bTemp = InStr(sEMail, Chr(34)) > 0

If bTemp Then GoTo exit_function

' Check if there's any other disallowed chars

' optimize a little if sEmail longer than sInvalidChars

' check the other way around

If Len(sEMail) > Len(sInvalidChars) Then

For i = 1 To Len(sInvalidChars)

If InStr(sEMail, Mid(sInvalidChars, i, 1)) > 0 _

Then bTemp = True

If bTemp Then Exit For

Next

Else

For i = 1 To Len(sEMail)

If InStr(sInvalidChars, Mid(sEMail, i, 1)) > 0 _

Then bTemp = True

If bTemp Then Exit For

Next

End If

If bTemp Then GoTo exit_function

' extra check

' no two consecutive dots

bTemp = InStr(sEMail, "..") > 0

If bTemp Then GoTo exit_function

exit_function:

' if any of the above are true, invalid e-mail

IsValidEmail = Not bTemp

End Function

Dim bTemp As Boolean

Dim i As Integer

Dim sTemp As String

' Disallowed characters

sInvalidChars = "!#$%^&*()=+{}[]|\;:'/?>,< "

' Check that there is at least one '@'

bTemp = InStr(sEMail, "@") <= 0

If bTemp Then GoTo exit_function

' Check that there is at least one '.'

bTemp = InStr(sEMail, ".") <= 0

If bTemp Then GoTo exit_function

' and that the length is at least six (a@a.ca)

bTemp = Len(sEMail) < 6

If bTemp Then GoTo exit_function

' Check that there is only one '@'

i = InStr(sEMail, "@")

sTemp = Mid(sEMail, i + 1)

bTemp = InStr(sTemp, "@") > 0

If bTemp Then GoTo exit_function

'extra checks

' AFTER '@' space is not allowed

bTemp = InStr(sTemp, " ") > 0

If bTemp Then GoTo exit_function

' Check that there is one dot AFTER '@'

bTemp = InStr(sTemp, ".") = 0

If bTemp Then GoTo exit_function

' Check if there's a quote (")

bTemp = InStr(sEMail, Chr(34)) > 0

If bTemp Then GoTo exit_function

' Check if there's any other disallowed chars

' optimize a little if sEmail longer than sInvalidChars

' check the other way around

If Len(sEMail) > Len(sInvalidChars) Then

For i = 1 To Len(sInvalidChars)

If InStr(sEMail, Mid(sInvalidChars, i, 1)) > 0 _

Then bTemp = True

If bTemp Then Exit For

Next

Else

For i = 1 To Len(sEMail)

If InStr(sInvalidChars, Mid(sEMail, i, 1)) > 0 _

Then bTemp = True

If bTemp Then Exit For

Next

End If

If bTemp Then GoTo exit_function

' extra check

' no two consecutive dots

bTemp = InStr(sEMail, "..") > 0

If bTemp Then GoTo exit_function

exit_function:

' if any of the above are true, invalid e-mail

IsValidEmail = Not bTemp

End Function

## No comments:

## Post a Comment