Приведенный ниже код выполняет поиск в документе 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