A number of submissions I get are duplicates. Not duplicates as in the same code, just more along the lines of "same concept, different code." Sort of like the For-Case Paradigm. To keep things fresh, I avoid posting duplicates unless they somehow manage to trump the quality of the original concept. Although we certainly have seen an interesting email validator before, I think I think it may be a little while before we see a third email validation example after Keith Lawrence's find ... 

Function isEmail(ByRef Invalue)
  Dim valueStr
  valueStr = trim(CStr(Invalue))  
  If (Not(detectedEmailBadCharacters(valueStr))) Then
    If (Not(detectDoubleDotInARow(valueStr))) Then  
      If (Not(detectDoubleAtSimbol(valueStr))) Then
        If (isUserNameOk(valueStr)) Then
          If (isExtensionOK(valueStr)) Then
            If (isHostNameOK(valueStr)) Then
              isEmail = True
            Else
              isEmail = False
            End If
          Else
            isEmail = False
          End If
        Else
          isEmail = False
        End If
      Else
        isEmail = False
      End If
    Else
      isEmail = False
    End If
  Else
    isEmail = False
  End If
End Function

Function detectedEmailBadCharacters(ByRef strInput)
  Dim bad_chars, foundOne, counter, strIn, i, ch, a, bad_char
  bad_chars = "!$%^""&*()+={[}]:;'~#<,>?/|\ "
  'string of Nasty characters to be checked for.
  foundOne = False
  counter = 5
  strIn = CStr(strInput) 
  For i = 1 To Len(strIn)
    foundOne = False 
    ch = mid(strIn,i,1)
    For a = 1 To Len(bad_chars)
      bad_char = mid(bad_chars,a,1)
      If(ch = bad_char)Then
        detectedEmailBadCharacters = True 
        Exit Function
      End If   
    Next ' a
  Next ' i
  detectedEmailBadCharacters = False
End Function

Function isUserNameOk(strInput)
  Dim intIn
  intIn = InStr(strInput,"@")
  If intIn = 0 Then
    isUserNameOk = False
  Else   
    isUserNameOk = True
  End If 
End Function

Function isHostNameOK(ByRef strInput)
  If InStr(strInput," ") <> 0 Then
    isHostNameOK = False
    Exit Function
  ElseIf InStr(strInput,"@") = 1 Then
    isHostNameOK = False
    Exit Function
  ElseIf InStr((Len(strInput)-1),strInput,"@") <> 0 Then
    isHostNameOK = False
    Exit Function
  ElseIf InStr((Len(strInput)-1),strInput,".") <> 0 Then
    isHostNameOK = False
    Exit Function
  ElseIf InStr((Len(strInput)-1),strInput,"_") <> 0 Then
    isHostNameOK = False
    Exit Function
  Else
    isHostNameOK = True
    Exit Function
  End If
End Function

Function detectDoubleDotInARow(strInput)
  Dim ch, last_is_a_dot, i
  ch = "" 
  last_is_a_dot = False 
  For i = 1 To Len(strInput) 
    ch = mid(strInput,i,1) 
    If((ch = ".") And (last_is_a_dot = False)) Then
      last_is_a_dot = True
    ElseIf ch <> "." Then  
      last_is_a_dot = False
    ElseIf((ch = ".") And (last_is_a_dot = True)) Then
      detectDoubleDotInARow = True
      Exit Function
    End If
  Next 
  detectDoubleDotInARow = False
End Function 

Function detectDoubleAtSimbol(strInput)
  Dim ch, there_is_a_at_simbol, i
  ch = ""
  there_is_a_at_simbol = False
  For i = 1 To Len(strInput) 
    ch = mid(strInput,i,1)  
    If((ch = "@") And (there_is_a_at_simbol = False)) Then
      there_is_a_at_simbol = True
    ElseIf((ch = "@") And (there_is_a_at_simbol = True)) Then
      detectDoubleAtSimbol = True
      Exit Function
    End If   
  Next 
  detectDoubleAtSimbol = False
End Function

Function isExtensionOK(strInput) 
  Dim counter, there_is_a_dot, at_position, i, ch
  counter = 0
  there_is_a_dot = false
  at_position = InStr(1,strInput,"@") 
  For i = (at_position + 1) To Len(strInput)
    ch = mid(strInput,i,1)
    counter = counter + 1
    If((ch = ".") And (counter = 1)) Then
      isExtensionOK = False
      Exit Function
    ElseIf((ch = ".") And (counter > 1)) Then
      isExtensionOK = True
      Exit Function
    End If
  Next 
End Function
[Advertisement] BuildMaster allows you to create a self-service release management platform that allows different teams to manage their applications. Explore how!