Kod:
Function IsEmailAddress(ByVal strEmailAddr As String) As Boolean
Const cstrValidChars As String = "@_-.0123456789abcdefghijklmnopqrstuvwxyzİ"
Const cstrDot As String = "."
Const cstrAt As String = "@"
Const cintAddressLenMin As Integer = 6
Dim strValidChars As String
Dim booFailed As Boolean
Dim intPos As Integer
Dim intI As Integer
strEmailAddr = LCase(strEmailAddr)
For intI = 1 To Len(strEmailAddr)
If InStr(cstrValidChars, mid(strEmailAddr, intI, 1)) = 0 Then
booFailed = True
End If
Next
If booFailed = False Then
booFailed = Left(strEmailAddr, 1) = cstrAt
If booFailed = False Then
booFailed = Left(strEmailAddr, 1) = cstrDot
If booFailed = False Then
intPos = Len(strEmailAddr)
booFailed = (intPos < cintAddressLenMin)
If booFailed = False Then
booFailed = (InStr(intPos - 1, strEmailAddr, cstrDot) > 0)
If booFailed = False Then
intPos = InStr(strEmailAddr, cstrAt)
booFailed = (intPos = 0)
If booFailed = False Then
booFailed = (InStr(intPos + 1, strEmailAddr, cstrAt) > 0)
If booFailed = False Then
booFailed = (mid(strEmailAddr, intPos - 1, 1) = cstrDot)
If booFailed = False Then
booFailed = (mid(strEmailAddr, intPos + 1, 1) = cstrDot)
If booFailed = False Then
booFailed = Not (InStr(intPos, strEmailAddr, cstrDot) > 1)
End If
End If
End If
End If
End If
End If
End If
End If
End If
IsEmailAddress = Not booFailed
End Function