Reputation: 19
I have a Word doc with some numbers referred in the foot notes. and I am exporting these references as a csv file.
Sub FindNumber()
Dim exp, exp1 As RegExp
Set exp = New RegExp
exp.Pattern = "\b[A-Za-z]{3}[0-9]{7}\b"
exp.Global = True
Dim splits(1000) As String
Dim x As Long
Dim results As MatchCollection
Set results = exp.Execute(ActiveDocument.StoryRanges(wdFootnotesStory))
x = 1
For Each res In results
splits(x) = res
x = x + 1
Next res
Dim Filename As String, line As String
Dim i As Integer
Filename = "C:\VBA Export" & "\Numbers.csv"
Open Filename For Output As #2
Print #2, "Control Numbers"
For i = LBound(splits) To UBound(splits)
Print #2, splits(i)
Next i
Close #2
MsgBox "Numbers were exported to " & Filename, vbInformation
End Sub
The code above was working fine and just suddenly starting throwing error at 'splits(x) = res' I have tried checking my regex and I can see that it works fine. If I change splits(x) to splits(6) or something similar it works like a charm .
Can someone please help ?
Upvotes: 0
Views: 69
Reputation: 166381
EDIT - changed code to write matches directly to Excel.
Sub Tester()
Dim oXl As Excel.Application 'add reference to MS Excel object library...
Dim oWb As Excel.Workbook, c As Excel.Range, i As Long, col As Collection
Set oXl = New Excel.Application
oXl.Visible = True
Set oWb = oXl.Workbooks.Add()
Set c = oWb.Worksheets(1).Range("A1")
ListMatchesInExcel ActiveDocument.StoryRanges(wdFootnotesStory), _
"\b[A-Za-z]{3}[0-9]{7}\b", _
"Id Numbers", c
Set c = c.Offset(0, 1)
ListMatchesInExcel ActiveDocument.StoryRanges(wdFootnotesStory), _
"\b[A-Za-z]{2}[0-9]{9}\b", _
"Other Numbers", c
Set c = c.Offset(0, 1)
'etc etc
End Sub
'Search through `SearchText` for text matching `patt` and export all
' matches to Excel with a header `HeaderText`, starting at range `c`
Sub ListMatchesInExcel(SearchText As String, patt As String, _
headerText As String, c As Excel.Range)
'add reference to MicroSoft VBscript regular expressions
Dim exp, exp1 As RegExp, col As New Collection
Dim results As MatchCollection, res As Match, i As Long
Set exp = New RegExp
exp.Pattern = patt
exp.Global = True
Set results = exp.Execute(SearchText)
'log to Immediate pane
Debug.Print (col.Count - 1) & " matche(s) for '" & patt & "'"
c.Value = headerText
i = 1
For Each res In results
c.Offset(i).Value = res
i = i + 1
Next res
c.EntireColumn.AutoFit
End Sub
Upvotes: 2