Binaryworld - IsValidPhoneField - Check whether a phone number is valid ... [ VB -> String ]

' Validate attributes of Phone data
' Returns True if valid, False if invalid
'
' Also returns the phone in formatted fashion (USA format).
' Will convert alphabetics to numeric
'
'Example:
' If IsValidPhoneField(Value:="3034414444", ReformattedPhone:=strNewPhone,
' '    IsRequired:=True, IsUSAPhone:=True) then ...

Function IsValidPhoneField(ByVal Caption As String, Value As Variant, _
  ReformattedPhone As String, Optional ByVal IsRequired As Boolean = True, _
  Optional ByVal IsUSAPhone As Boolean = True) As Boolean
  Dim intNbrDigits As Integer
  Dim strTemp As String
  Dim blnHasExtension As Boolean
  Dim strExtension As String
  Dim i As Integer

  On Error GoTo ErrorHandler

  IsValidPhoneField = True
  Value = Trim$(Value)

  If Value = "" Then
    If IsRequired Then
      IsValidPhoneField = False
    Else
      Exit Function
    End If
  End If

  If Len(Value) > 25 Then
    IsValidPhoneField = False
  End If

  If IsUSAPhone Then
    intNbrDigits = 0
    strTemp = ""
    blnHasExtension = False

    'Extract the extension if there is one.
    If Len(Value) <= 7 Then
      For i = 1 To Len(Value)
        If UCase$(Mid(Value, i, 1)) <> "X" Then
          strTemp = Trim(strTemp) + Mid(Value, i, 1)
        End If
      Next
      If Len(strTemp) = 7 Then
        strTemp = ""
      Else
        blnHasExtension = True
        strExtension = Trim(strTemp)
        strTemp = ""
        Value = ""
      End If
    End If

    For i = Len(Value) To 1 Step -1
      If UCase$(Mid(Value, i, 2)) = " X" Then
        blnHasExtension = True
        strExtension = Mid(Value, i + 2, Len(Value) - (i + 1))
        Value = Mid(Value, 1, i - 1)
        Exit For
      End If
    Next

    'Change alphabetics to numbers ex. 1-94Perot
    For i = 1 To Len(Value)
      Select Case UCase$(Mid(Value, i, 1))
        Case "A" To "C"
          strTemp = Trim(strTemp) + "2"
        Case "D" To "F"
          strTemp = Trim(strTemp) + "3"
        Case "G" To "I"
          strTemp = Trim(strTemp) + "4"
        Case "J" To "L"
          strTemp = Trim(strTemp) + "5"
        Case "M" To "O"
          strTemp = Trim(strTemp) + "6"
        Case "P" To "S"
          strTemp = Trim(strTemp) + "7"
        Case "T" To "V"
          strTemp = Trim(strTemp) + "8"
        Case "W" To "Y"
          strTemp = Trim(strTemp) + "9"
        Case "0" To "9"
          strTemp = Trim(strTemp) + Mid(Value, i, 1)
       End Select
    Next

    Value = strTemp

    intNbrDigits = Len(Value)

    ' Format 123-4567
    If intNbrDigits = 7 Then
      Value = Mid(strTemp, 1, 1) + Mid(strTemp, 2, 1) + Mid(strTemp, 3, _
        1) + "-" + Mid(strTemp, 4, 1) + Mid(strTemp, 5, _
        1) + Mid(strTemp, 6, 1) + Mid(strTemp, 7, 1)
    End If

    ' Format 1-234-567-8901
    If intNbrDigits = 11 Then
      Value = Mid(strTemp, 1, 1) + "-" + Mid(strTemp, 2, 1) + Mid(strTemp, _
        3, 1) + Mid(strTemp, 4, 1) + "-" + Mid(strTemp, 5, _
        1) + Mid(strTemp, 6, 1) + Mid(strTemp, 7, _
        1) + "-" + Mid(strTemp, 8, 1) + Mid(strTemp, 9, _
        1) + Mid(strTemp, 10, 1) + Mid(strTemp, 11, 1)
    End If

    ' Format 123-456-7890
    If intNbrDigits = 10 Then
      Value = Mid(strTemp, 1, 1) + Mid(strTemp, 2, 1) + Mid(strTemp, 3, _
        1) + "-" + Mid(strTemp, 4, 1) + Mid(strTemp, 5, _
        1) + Mid(strTemp, 6, 1) + "-" + Mid(strTemp, 7, _
        1) + Mid(strTemp, 8, 1) + Mid(strTemp, 9, 1) + Mid(strTemp, 10, _
        1)
    End If

    ' Append extension
    If blnHasExtension Then
      Value = Trim(Value) + " x" + Trim(strExtension)
    End If

    Value = Trim(Value)
    If intNbrDigits = 0 Or intNbrDigits = 7 Or intNbrDigits = 10 Or _
      intNbrDigits = 11 Then
    'do nothing
    Else
      IsValidPhoneField = False
    End If
  End If

  ReformattedPhone = Value
ExitMe:
  Exit Function
ErrorHandler:
  Err.Raise Err.Number, "IsValidPhoneField", Err.Description

End Function