MS Word - tìm số, không phải chữ số riêng lẻ

Mã bên dưới tìm kiếm tài liệu MS Word, trích xuất số và đặt chúng vào Excel.

Điều tôi cần là nếu tài liệu có số như 12345, nó cần trích xuất 12345 chứ không phải 1, 2, 3, 4 và 5. Tôi có số lượng độ dài khác nhau trong toàn bộ tài liệu.

Tôi nhận ra điều đó .Text = "[0-9]"và tôi thiếu regex nhưng hy vọng ai đó có thể giúp đỡ.

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