I was helping in the Microsoft Answers Forum today:

MS Access Extracting phone numbers from string - Microsoft Community

Hi. In MS Access, I am trying to extract phone numbers from a string and put them in 1 row each. I have tried a few functions, but nothing has worked. Example: 555-555-1001, 555-555-1002, X1E-D2SQ

and thought I’d share the solution here as I’ve seen similar questions in the past.

Basically, the user had a string, any string, and wanted to extract all the phone numbers from it.  The phone numbers, originally, were of the 000-000-0000 format.

I knew the best approach would be to use a regular expression (RegEx) and I remembered that a while back I helped another forum user with a similar question regarding extracting e-mail addresses from a string and so I thought that it would give me a great starting point to build from.  So, I turned towards my prior post

Returning an Array of Values

With that in hand, it was then just a question of building the appropriate pattern for the RegEx.  Now there are tons of variations that could work, some more complete than others, but below is what I ended up testing which worked for this specific scenario.

'---------------------------------------------------------------------------------------
' Procedure : ExtractEmailAddresses
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Extract phone numbers from a supplied string
'               Returns an array of the phone numbers
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
' Reference : https://www.devhut.net/vba-extract-email-addresses-from-a-string/
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sInput    : String to parse/extract phone numbers from
'
' Usage:
' ~~~~~~
' See TestMe Sub
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2021-12-07              Initial Release, Forum Help
'---------------------------------------------------------------------------------------
Public Function ExtractPhoneNo(ByVal sInput As Variant) As Variant
    On Error GoTo Error_Handler
    Dim oRegEx                As Object
    Dim oMatches              As Object
    Dim oMatch                As Object
    Dim sPhoneNo              As String

    If Not IsNull(sInput) Then
        Set oRegEx = CreateObject("VBScript.RegExp")
        With oRegEx
            .Pattern = "([0-9]{3}-[0-9]{3}-[0-9]{4})"
            .Global = True
            .IgnoreCase = True
            .MultiLine = True
            Set oMatches = .Execute(sInput)
        End With
        For Each oMatch In oMatches
            sPhoneNo = oMatch.Value & "," & sPhoneNo
        Next oMatch
        If Right(sPhoneNo, 1) = "," Then sPhoneNo = Left(sPhoneNo, Len(sPhoneNo) - 1)
        ExtractPhoneNo = Split(sPhoneNo, ",")    'Return an array of email addresses extracted from sInput
    Else
        ExtractPhoneNo = Null
    End If

Error_Handler_Exit:
    On Error Resume Next
    If Not oMatch Is Nothing Then Set oMatch = Nothing
    If Not oMatches Is Nothing Then Set oMatches = Nothing
    If Not oRegEx Is Nothing Then Set oRegEx = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ExtractPhoneNo" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

and an example of its usage could be:

Sub Test()
    Dim aPhoneNos             As Variant
    Dim i                     As Long

    aPhoneNos = ExtractPhoneNo("555-555-1001, 555-555-1002, X1E-D2SQ, 555-554-3411, SWQ-21AK, 555-554-5212")
    For i = 0 To UBound(aPhoneNos)
        Debug.Print i + 1, aPhoneNos(i)
    Next i
End Sub

Running the above outputs:

 1            555-554-5212
 2            555-554-3411
 3            555-555-1002
 4            555-555-1001

This approach can be great if you wish to iterate over the result to push them to a table, use the values to populate a combo box/listbox, … or perform some specific action on each value.

Returning a Delimited List

What if you wanted a delimited list, rather than an array that you need to iterate through? Well, nothing could be easier!

'---------------------------------------------------------------------------------------
' Procedure : ExtractEmailAddresses
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Extract phone numbers from a supplied string
'               Returns a Delimited string of the phone numbers
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
' Reference : https://www.devhut.net/vba-extract-email-addresses-from-a-string/
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sInput    : String to parse/extract phone numbers from
' sDelim    : Delimiter to use to separate the values with
'
' Usage:
' ~~~~~~
' ? ExtractDelimPhoneNo("555-555-1001, 555-555-1002, X1E-D2SQ, 555-554-3411, SWQ-21AK, 555-554-5212")
'       Returns -> 555-554-5212,555-554-3411,555-555-1002,555-555-1001
' ? ExtractDelimPhoneNo("555-555-1001, 555-555-1002, X1E-D2SQ, 555-554-3411, SWQ-21AK, 555-554-5212", "~!")
'       Returns -> 555-554-5212~!555-554-3411~!555-555-1002~!555-555-1001
' ? ExtractDelimPhoneNo("555-555-1001, 555-555-1002, X1E-D2SQ, 555-554-3411, SWQ-21AK, 555-554-5212", vbCrLf)
'       Returns -> 555-554-5212
'                  555-554-3411
'                  555-555-1002
'                  555-555-1001
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2021-12-07              Initial Release, Forum Help
'---------------------------------------------------------------------------------------
Public Function ExtractDelimPhoneNo(ByVal sInput As Variant, Optional ByVal sDelim As String = ",") As String
    On Error GoTo Error_Handler
    Dim oRegEx                As Object
    Dim oMatches              As Object
    Dim oMatch                As Object
    Dim sPhoneNo              As String

    If Not IsNull(sInput) Then
        Set oRegEx = CreateObject("VbScript.RegExp")
        With oRegEx
            .Pattern = "([0-9]{3}-[0-9]{3}-[0-9]{4})"
            .Global = True
            .IgnoreCase = True
            .MultiLine = True
            Set oMatches = .Execute(sInput)
        End With
        For Each oMatch In oMatches
            sPhoneNo = oMatch.Value & sDelim & sPhoneNo
        Next oMatch

        If sPhoneNo <> "" Then sPhoneNo = Left(sPhoneNo, Len(sPhoneNo) - Len(sDelim))
        ExtractDelimPhoneNo = sPhoneNo
    Else
        ExtractDelimPhoneNo = ""
    End If

Error_Handler_Exit:
    On Error Resume Next
    If Not oMatch Is Nothing Then Set oMatch = Nothing
    If Not oMatches Is Nothing Then Set oMatches = Nothing
    If Not oRegEx Is Nothing Then Set oRegEx = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ExtractDelimPhoneNo" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

This approach is great for when you simply wish to build a single string for use in queries/reporting in which you want all the values concatenated together.

A Final Word On The Subject

Never forget that the beauty of RegEx is that if your phone numbers are in a different format, it’s just a question of adjusting the RegEx pattern to one that suits your needs (add parenthesis, make characters optional, …).

Also, as I’ve mentioned in other posts, the web is filled with sites with sample patterns. So before reinventing the wheel perform a quick search as someone has probably already done what it is you are trying to do and you may be able to save yourself considerable time and frustration by simply adopting their pattern.

As you can see, it is very easy parse a string and extract all the phone numbers.

I hope this helps a few people out there.