MS Word - znajdź liczby, a nie poszczególne cyfry

Poniższy kod przeszukuje dokument MS Word, wyodrębnia liczby i umieszcza je w programie Excel.

Potrzebuję tylko, jeśli dokument ma numer taki jak 12345, musi wyodrębnić 12345, a nie 1, 2, 3, 4 i 5. Mam w dokumentach liczby o różnej długości.

Zdaję sobie sprawę, że to wina .Text = "[0-9]"mojego braku wyrażenia regularnego, ale miałem nadzieję, że ktoś może pomóc.

Public Sub NumbersToExcel()
    Dim xlApp As Object
    Dim xlWbk As Object
    Dim xlWsh As Object
    Dim blnStartExcel As Boolean
    Dim i As Integer

    On Error Resume Next

    Set xlApp = GetObject(, "Excel.Application")
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
        If xlApp Is Nothing Then
            MsgBox "Cannot activate Excel!", vbExclamation
            Exit Sub
        End If
        blnStartExcel = True
    End If

    On Error GoTo ErrHandler

    Set xlWbk = xlApp.Workbooks.Add
    Set xlWsh = xlWbk.Worksheets(1)

    With ActiveDocument.Content
        With .Find
            .ClearFormatting
            .Text = "[0-9]"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
        End With
        While .Find.Execute
            i = i + 1
            xlWsh.Cells(i, 1) = "'" & .Text
        Wend
        .Find.MatchWildcards = False
    End With

ExitHandler:
    On Error Resume Next
    xlWbk.Close SaveChanges:=True
    If blnStartExcel Then
        xlApp.Quit
    End If
    Set xlWsh = Nothing
    Set xlWbk = Nothing
    Set xlApp = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler

End Sub