Caution

This function cannot verify that an email address is an existing one. It only checks the syntax to verify that the address may be legitimate.

IsEmailValid (StrEmail)

The argument is

StrEmail—An email address

Function IsEmailValid(strEmail As String) As Boolean

Dim strArray As Variant

Dim strltem As Variant

Dim i As Long

Dim c As String

Dim blnlsltValid As Boolean blnlsltValid = True

'count the @ in the string i = Len(strEmail) - Len(Application.Substitute(strEmail, ""))

'if there is more than one invalid email If i <> 1 Then IsEmailValid = False: Exit Function ReDim strArray(1 To 2)

'the following two lines place the text to the left and right 'of the @ in their own variables strArray(1) = Left(strEmail, InStr(1, strEmail, 1) - 1)

strArray(2) = Application.Substitute(Right(strEmail, Len(strEmail) Len(strArray(1))), "@", "")

For Each strItem In strArray

'verify there is something in the variable. 'If there isn't, then part of the email is missing If Len(strItem) <= 0 Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If

'verify only valid characters in the email For i = 1 To Len(strItem)

'lowercases all letters for easier checking c = LCase(Mid(strItem, i, 1))

If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 _ And Not IsNumeric(c) Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If Next i

'verify that the first character of the left and right aren't periods If Left(strItem, 1) = "." Or Right(strItem, 1) = "." Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If Next strItem

'verify there is a period in the right half of the address If InStr(strArray(2), ".") <= 0 Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If i = Len(strArray(2)) - InStrRev(strArray(2), ".") 'locate the period 'verify that the number of letters corresponds to a valid domain extension If i <> 2 And i <> 3 And i <> 4 Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If

'verify that there aren't two periods together in the email If InStr(strEmail, "..") > 0 Then blnIsItValid = False IsEmailValid = blnIsItValid Exit Function End If

IsEmailValid = blnIsItValid End Function

Figure 4.4

Validating email addresses.

0 0

Post a comment