Public Function IsValidEMail(S)
Dim Ch As String * 1, I As Long, Ats As Long, Periods As Long
Dim LeftofAt As Boolean, IsLeading As Boolean
IsValidEMail = True
If IsNull(S) Then Exit Function
IsValidEMail = False
LeftofAt = True
IsLeading = True
Periods = 0
Ats = 0
For I = 1 To Len(S)
Select Case Asc(Mid(S, I, 1))
Case Asc("@")
Ats = Ats + 1
If I = 1 Then Exit Function
If Ats > 1 Then Exit Function
LeftofAt = False
IsLeading = True
Case Asc(".")
If Not LeftofAt Then Periods = Periods + 1
If Periods > 4 Then Exit Function
If I > Len(S) - 2 Then Exit Function
Case Asc("A") To Asc("Z"), Asc("a") To Asc("z"), Asc("0") To Asc("9")
IsLeading = False
Case Asc("Ä"),Asc("Ö"),Asc("Ü"),Asc("ä"),Asc("ö"),Asc("ü")
IsLeading = False
Case Asc("-")
If IsLeading Then Exit Function
Case Asc("_")
If IsLeading Or Not LeftofAt Then Exit Function
Case Else
Exit Function
End Select
Next
If Periods > 0 Then IsValidEMail = True
End Function