Public Function ValidateEMail(ByVal strAddress As String) As Boolean

Dim lngIndex As Long ' Position på strAddress
Dim lngCountAt As Long ' Antal "@"
Dim lngLastDotPos As Long ' Position på föregående punkt
Dim strCurrentChar As String ' Buffer med strängens innehåll, ett tecken i taget.

On Error GoTo Fail_Validation

ValidateEMail = True
strAddress = Trim(strAddress)
lngLastDotPos = 0
lngCountAt = 0

' Finns inte minst (a@b.se) som längd,
' är inte adressen korrekt
If Len(strAddress) < 6 Then GoTo Fail_Validation

' Kolla vissa tecken i början av adressen.
strCurrentChar = Left$(strAddress, 1)
If strCurrentChar = "." Or strCurrentChar = "@" Or strCurrentChar = "_" Or _
strCurrentChar = "-" Then GoTo Fail_Validation

' Kontrollerar strängen mot ej godkända tecken.
For lngIndex = 1 To Len(strAddress)
strCurrentChar = Mid$(strAddress, lngIndex, 1)

' Räknar antalet "@".
If strCurrentChar = "@" Then lngCountAt = lngCountAt + 1

' Saknas punkt, är adressen ej korrekt.
If strCurrentChar = "." Then
If lngIndex = lngLastDotPos + 1 Then
GoTo Fail_Validation
Else
lngLastDotPos = lngIndex
End If
End If

Select Case Asc(strCurrentChar)
' Dessa tecken får inte användas i en email adress.
Case 1 To 44, 47, 58 To 63, 91 To 94, 96, 123 To 127, 128 To 255
GoTo Fail_Validation
End Select
Next lngIndex

' Saknas det, och endast ett "@" finns, är inte adressen korrekt
If lngCountAt <> 1 Then GoTo Fail_Validation

' Om extension inte är känt, är inte adressen godkänd
Select Case Mid(strAddress,lngLastDotPos)
Case ".se", ".nu" , ".com", ".org", ".net", ".edu", ".mil", ".gov"
' godkänt
Case Else
GoTo Fail_Validation
End Select

ValidateEMail_Exit:
Exit Function

Fail_Validation:
ValidateEMail = False
GoTo ValidateEMail_Exit
End Function