VBA - Find paragraph starting with numbers - vba

Question

I'm using a VBA script to try to find the starting number of a paragraph (they are list items not formatted as such - not trying to format, just find the numbers).
1. First Item
2. Second Item
No number - don't include despite 61.5 in paragraph.
25 elephants should not be included
12. Item Twelve, but don't duplicate because of Susie's 35 items
Is there any way to say in VBA "If start of paragraph has 1-2 numbers, return those numbers". In regex, what I'm looking for is ^(\d\+)\.
Here is a working bit of VBA code - haven't figured out how to CREATE the excel file yet, so if you go to test create a blank test.xslx in your temp folder. Of course this may be simple enough that testing isn't necessary.
Sub FindWordCopySentence()
On Error Resume Next
Dim appExcel As Object
Dim objSheet As Object
Dim aRange As Range
Dim intRowCount As Integer
intRowCount = 1
' Open Excel File
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
'Change the file path to match the location of your test.xls
Set objSheet = appExcel.workbooks.Open("C:\temp\test.xlsx").Sheets("Sheet1")
intRowCount = 1
End If
' Word Document Find
Set aRange = ActiveDocument.Range
With aRange.Find
Do
.ClearFormatting
' Find 1-2 digit number
.Text = "[0-9]{1,2}"
.MatchWildcards = True
.Execute
If .Found Then
' Copy to Excel file
aRange.Expand Unit:=wdSentence
aRange.Copy
aRange.Collapse wdCollapseEnd
objSheet.Cells(intRowCount, 1).Select
objSheet.Paste
intRowCount = intRowCount + 1
End If
Loop While .Found
End With
Set aRange = Nothing
If Not objSheet Is Nothing Then
appExcel.workbooks(1).Close True
appExcel.Quit
Set objSheet = Nothing
Set appExcel = Nothing
End If
End Sub
Thanks!

Answer 1

I would go quite a bit simpler and just check the first few characters of the paragraph:
Option Explicit
Sub test()
Dim para As Paragraph
For Each para In ThisDocument.Paragraphs
With para.Range
If (.Characters(2) = ".") Or (.Characters(3) = ".") Then
If IsNumeric(para.Range.Words(1)) Then
Debug.Print "Do something with paragraph number " & _
para.Range.Words(1) & "."
End If
End If
End With
Next para
End Sub

Answer 2

A more efficient approach, which obviates the need to test every paragraph:
Sub Demo()
Application.ScreenUpdating = False
Dim StrOut As String
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^13[0-9.]{1,}" ' or: .Text = "^13[0-9]{1,}
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
StrOut = StrOut & .Text
' or: MsgBox Split(.Text, vbCr)(1)
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
MsgBox StrOut
End Sub
As coded, the macro returns the entire list strings where there may be multiple levels (e.g. 1.2). Comments show how to find just the first number where there may be multiple levels and how to extract that number for testing (the Find expression includes the preceding paragraph break).