May 14, 2001

Check ValidEmail Address (VB6.0)

VERSION 5.00
Begin VB.Form checkEmailaddress
Caption = "Form6"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form6"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 555
Left = 1350
TabIndex = 1
Top = 1710
Width = 1755
End
Begin VB.TextBox Text1
Height = 555
Left = 330
TabIndex = 0
Text = "ajit@mungale.com"
Top = 420
Width = 3945
End
End
Attribute VB_Name = "checkEmailaddress"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Function IsEMailAddress(ByVal sEmail As String, _
Optional ByRef sReason As String) As Boolean

Dim sPreffix As String
Dim sSuffix As String
Dim sMiddle As String
Dim nCharacter As Integer
Dim sBuffer As String

sEmail = Trim(sEmail)

If Len(sEmail) < isemailaddress =" False" sreason = "Too short" isemailaddress =" False" sreason = "Missing the @"> 0 Then
IsEMailAddress = False
sReason = "Too many @"
Exit Function
End If


If InStr(sEmail, ".") = 0 Then
IsEMailAddress = False
sReason = "Missing the period"
Exit Function
End If

If InStr(sEmail, "@") = 1 Or InStr(sEmail, "@") = Len(sEmail) Or _
InStr(sEmail, ".") = 1 Or InStr(sEmail, ".") = Len(sEmail) Then
IsEMailAddress = False
sReason = "Invalid format"
Exit Function

End If


For nCharacter = 1 To Len(sEmail)
sBuffer = Mid$(sEmail, nCharacter, 1)
If Not (LCase(sBuffer) Like "[a-z]" Or sBuffer = "@" Or _
sBuffer = "." Or sBuffer = "-" Or sBuffer = "_" Or _
IsNumeric(sBuffer)) Then: IsEMailAddress = _
False: sReason = "Invalid character": Exit Function
Next nCharacter

nCharacter = 0

On Error Resume Next

sBuffer = Right(sEmail, 4)
If InStr(sBuffer, ".") = 0 Then GoTo TooLong:
If Left(sBuffer, 1) = "." Then sBuffer = Right(sBuffer, 3)
If Left(Right(sBuffer, 3), 1) = "." Then sBuffer = Right(sBuffer, 2)
If Left(Right(sBuffer, 2), 1) = "." Then sBuffer = Right(sBuffer, 1)


If Len(sBuffer) < isemailaddress =" False" sreason = "Suffix too short"> 3 Then
IsEMailAddress = False
sReason = "Suffix too long"
Exit Function
End If

sReason = Empty
IsEMailAddress = True

End Function


Private Sub Command1_Click()
Dim IsValid As Boolean
Dim InvalidReason As String

IsValid = IsEMailAddress(Text1.Text, InvalidReason)

MsgBox "Is the e-mail address valid? - " & IsValid

MsgBox "If invalid, the reason given is: " & InvalidReason

End Sub