MS Word - 個々の数字ではなく数字を検索する

Question

以下のコードは、MS Word 文書を検索し、数値を抽出して Excel に入力します。

必要なのは、ドキュメントに 12345 のような数字がある場合、1、2、3、4、5 ではなく、12345 を抽出することです。ドキュメント全体でさまざまな長さの数字があります。

これは正規表現が不足していることが原因だと認識しています.Text = "[0-9]"が、誰かが助けてくれることを期待しています。

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