View Single Post
 
Old 07-16-2015, 11:42 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 19,760
macropod has much to be proud ofmacropod has much to be proud ofmacropod has much to be proud ofmacropod has much to be proud ofmacropod has much to be proud ofmacropod has much to be proud ofmacropod has much to be proud ofmacropod has much to be proud of
Default

I was thinking of something like:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim StrTmp As String, StrRec As String, StrDat As String
Dim i As Long, j As Long, x As Long, StrFlNm As String
StrFlNm = "C:\Users\" & Environ("UserName") & "\Documents\CorpData.txt"
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[0-9]{7,9}[ ]{3}[!^13]{1,}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found = True
    x = x + 1
    StrRec = .Text
    StrTmp = Split(StrRec, " ")(0)
    i = Len(StrRec): j = Len(StrTmp)
    StrDat = StrDat & Chr(34) & StrTmp & Chr(34) & vbTab & _
      Chr(34) & Trim(Right(StrRec, i - j)) & Chr(34) & vbCrLf
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  If Len(StrDat) > 1 Then
    Close #1
    StrDat = Left(StrDat, Len(StrDat) - 1)
    Open StrFlNm For Output As #1
    Print #1, StrDat
    Close #1
  End If
End With
StatusBar = "Done! The output for " & x & " records is now in: " & StrFlNm
Application.ScreenUpdating = True
End Sub
This produces a tab-delimited text file and the whole process should be much faster than looping through every paragraph.
To produce a csv file instead (e.g. for import into Excel), simply change CorpData.txt to CorpData.csv and change vbTab to ",".
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote