Приведенный ниже код выполняет поиск в документе MS Word, извлекает числа и помещает их в Excel.

Что мне нужно, так это если в документе есть число, например 12345, нужно извлечь 12345, а не 1, 2, 3, 4 и 5. У меня есть номера различной длины по всему документу.

Я понимаю, что это до .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

0