controllo formato casella di testo

Function emailTest(eAddr As String) As Boolean
    
    Dim myStr As String
    Dim MyChar As String
    Dim i As Long
    Dim n As Long
    Dim myArr
    
    emailTest = False
    
'test for 1 and only 1 "@" character, and no double 'dots'.
    If InStr(1, eAddr, "..") > 0 Then Exit Function
    myArr = Split(eAddr, "@")
    If UBound(myArr) <> 1 Then Exit Function
    
'tests for local segment of address (left of @)
    myStr = myArr(0)
    'Local name segment can be entirely in quotes (chr34) with any characters in between.
    If Left(myStr, 1) = Chr(34) And Right(myStr, 1) = Chr(34) _
     And Len(myStr) > 3 Then
        'skip next step - evaluation by character
    Else
        For i = 1 To Len(myStr)
            MyChar = Mid(myStr, i, 1)
            Select Case MyChar
                Case "0" To "9", "a" To "z", "A" To "Z"
                    'allow, and continue to next char
                Case "-", "!", "#", "$", "%", "'", "*", _
                     "+", "=", "?", "^", "`", "{", "}", _
                     "|", "~", ".", "_"
                    'these characters are not allowed at begin or end of local name
                    If i = 1 Or i = Len(myStr) Then Exit Function
                Case Else
                     Exit Function
            End Select
        Next i
    End If


'tests for domain portion of address (right of @)
    myStr = myArr(1)
    myArr = Split(myStr, ".")
    'test for at least one dot
    If UBound(myArr) = 0 Then Exit Function
    
'test for domain as ip address
    '(i.e. must begin and end with [] brackets, and have four numeric segments
    ' separated by dots, each segment being one to three digits.
    If Left(myStr, 1) = "[" And Right(myStr, 1) = "]" _
      And UBound(myArr) = 3 Then
        For n = 0 To 3
            myStr = myArr(n)
            myStr = Replace(myStr, "[", "")
            myStr = Replace(myStr, "]", "")
            If Len(myStr) > 3 Or Not IsNumeric(myStr) Then Exit Function
        Next n
        emailTest = True
        'full address has passed, no need to continue evaluating domain chars
        Exit Function
    End If
'continue with evaluating the domain by non-IP rules and by character compliance
    If Len(myStr) > 253 Then Exit Function
    If UBound(myArr) > 126 Then Exit Function
    For n = 0 To UBound(myArr)
        myStr = myArr(n)
        'last label (highest domain level) must be at least 2 characters
        If n = UBound(myArr) And Len(myStr) < 2 Then Exit Function
        For i = 1 To Len(myStr)
            MyChar = Mid(myStr, i, 1)
            Select Case MyChar
                Case 0 To 9, "a" To "z", "A" To "Z"
                Case "-"
                    'hyphen char may be in middle but not begining or end of label
                    If i = 1 Or i = Len(myStr) Then Exit Function
                Case Else
                    Exit Function
            End Select
        Next i
    Next n
    
    emailTest = True
    
End Function