E-M@il Validation.

Here is a E-M@il Validation script. I'm sorry that there is no comment, i'm from the Netherlands and my english isn't that good.
 
Please comment :-)
 
Here is the code:
 
 
 
'Sorry that there is no comment. This validator is translated from Ducht to English.
'My English isn't that good, so i'm sorry if there are spelling mistakes :-)
Titel = "Email Validator © Jori Koolstra"
EmailValidate
Sub EmailValidate
Do Until EmailOK = True
Email = InputBox ("Please enter your E-M@ils adress.",Titel,"Enter your E-M@il adress here.")
Trim(Email)
Grote = Len(Email)
posAap=InStr(Email,"@")
'List of valid characters.
ValChar1=InStr(Email,"!")
ValChar2=InStr(Email,"#")
ValChar3=InStr(Email,"$")
ValChar4=InStr(Email,"%")
ValChar5=InStr(Email,"€")
ValChar6=InStr(Email,"^")
ValChar7=InStr(Email,"&")
ValChar8=InStr(Email,chr(34))
ValChar9=InStr(Email,"*")
ValChar10=InStr(Email,"=")
ValChar11=InStr(Email,"<")
ValChar12=InStr(Email,">")
ValChar13=InStr(Email,"{")
ValChar14=InStr(Email,"}")
ValChar15=InStr(Email,"|")
ValChar16=InStr(Email,"`")
ValChar17=InStr(Email,"~")
ValChar18=InStr(Email,"©")
ValChar19=InStr(Email,"®")
ValChar20=InStr(Email,"¶")
ValChar21=InStr(Email,"´")
If (ValChar1 => 1) Or (ValChar2 => 1) Or (ValChar3 => 1) Or (ValChar4 => 1) Or (ValChar5 => 1) Or (ValChar6 => 1) Or (ValChar7 => 1) Or (ValChar8 => 1) Or (ValChar9 => 1) Or (ValChar10 => 1) Or (ValChar11 => 1) Or (ValChar12 => 1) Or (ValChar13 => 1) Or (ValChar14 => 1) Or (ValChar15 => 1) Or (ValChar16 => 1) Or (ValChar17 => 1) Or (ValChar18 => 1) Or (ValChar19 => 1) Or (ValChar20 => 1) Or (ValChar21 => 1) Then
MsgBox "*" & Email & "* is a valid E-M@il adress!",16 + 4096,Titel + " - Error"
EmailValidate
End If
If ((posAap = 1) = True) Then
MsgBox "*" & Email & "* is a valid E-M@il adress!",16 + 4096,Titel + " - Error"
EmailValidate
End If
If Grote = 0 Then
MsgBox "You need to enter someting!",16 + 4096,titel + " Error"
EmailValidate
End If
If ((posAap = 1) = True) Then
MsgBox "*" & Email & "* is a valid E-M@il adress!",16 + 4096,Titel + " - Error"
EmailValidate
End If
posPunt=InStr(Email,".")
If posPunt = 0 Then
MsgBox "*" & Email & "* is a valid E-M@il adress!",16 + 4096,Titel + " - Error"
EmailValidate
End If
NewStr = Mid(Email,posAap,Grote)
posPuntNaAap = InStr(NewStr,".")
If posPuntNaAap = 0 Then
MsgBox "*" & Email & "* is a valid E-M@il adress!",16 + 4096,Titel + " - Error"
EmailValidate
End If
posAap2 = InStr(NewStr,"@")
NewStr2 = Mid(NewStr,posAap2,posPuntNaAap)
NewStr2Length = Len(NewStr2)
If NewStr2Length =< 2 Then
MsgBox "*" & Email & "* is a valid E-M@il adress!",16 + 4096,Titel + " - Error"
EmailValidate
End If
HulpLen = Len(NewStr)
NewStr3 = Mid(NewStr,posPuntNaAap,HulpLen)
If (InStr(NewStr3,"nl") = 0) And (InStr(NewStr3,"com") = 0) And (InStr(NewStr3,"be") = 0) And (InStr(NewStr3,"net") = 0) Then
'You can always add more . adresses.
MsgBox "*" & Email & "* is a valid E-M@il adress!",16 + 4096,Titel + " - Error"
EmailValidate
End If
If Len(NewStr3) => 5 Then
MsgBox "*" & Email & "* is a valid E-M@il adress!",16 + 4096,Titel + " - Error"
EmailValidate
End If
EmailOK = True
Loop
MsgBox "Your  E-M@il adress: *" &Email& "* is accepted!","32",Titel
Wscript.Quit
End Sub

Thanks for sharing, but wouldn't this (courtesy of Ginolard) be easier:

Function EmailAddress(input) 
    EmailAddress = False
    Set objregEx = New RegExp
    objregEx.Pattern ="^[\w-\.]{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,3}$"
    objregEx.IgnoreCase = True
    retVal = objregEx.Test(input)
    If Not retVal Then 
        Exit Function
    Else 
        EmailAddress = True
    End If
End Function

Yes alot easier :), but there are two reasons why I prefer my code.

1. There are more options to edit the validation. If you want you can put a DSN Server database to it. And you can specified the illegal character list.

2. Its a good string editing practice.

Btw, Thanks for your comment. :-)

Jori.