Create a new module and paste this code into it. Call the module basPhoneNumbers
If you have any questions, email us at help@codeoftheweek.com
'----------------------------------------------------------------------
'
' Module Name: basPhoneNumbers
' Written By: C&D Programming Corp.
' Create Date: 8/2000
' Copyright: Copyright 2000 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
Function FormatUSPhoneNumber(ByVal sPhone As String) As String
Dim i As Long
Dim j As Long
Dim sTempPhone As String
' ignore blank strings
If Len(sPhone) = 0 Then Exit Function
' preload the string for speed
sTempPhone = Space(Len(sPhone))
j = 0
For i = 1 To Len(sPhone)
' if this character is not numeric then toss it other wise save it
If InStr(1, "1234567890", Mid$(sPhone, i, 1)) > 0 Then
j = j + 1
Mid$(sTempPhone, j, 1) = Mid$(sPhone, i, 1)
End If
Next
' remove trailing blanks
sTempPhone = RTrim$(sTempPhone)
' raise an error if the phone number length is wrong
If Len(sTempPhone) <> 7 And Len(sTempPhone) <> 10 Then
Err.Raise 5, "FormatUSPhoneNumber", "Phone number must be 7 or 10 characters long."
End If
' do two different formats based on the length of the phone number
' one enhancement that might be nice here is to support a phone extension
' (although you probably want to store that separately anyway)
FormatUSPhoneNumber = Format$(sTempPhone, IIf(Len(sTempPhone) <= 7, "@@@-@@@@", "(@@@)@@@-@@@@"))
Exit Function
Handler:
Dim lErr As Long
Dim sErr As String
lErr = Err.Number
sErr = Err.Description
Err.Clear
Err.Raise lErr, "FormatUSPhoneNumber", sErr
End Function