Inserting text slowness

[jvbeaupre]

I'm trying to transfer a thinned set of data from one document to
another using the code below. Typically np= 500000 and nmod = 400. I've
noticed that as the loop progresses it takes longer and longer (and
longer) to transfer a paragraph.

Any ideas on how to speed up the process?

For ip = 1 To np Step nmod
qq = Documents(q1).Paragraphs(ip).Range.Text
Documents(q2).Content.InsertAfter qq
Debug.Print 1 + Int(ip / nmod), ip
Next ip


Thanks,
Jim


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
The whole program is as follows:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub thin()
Dim np As Long, ip As Long
Dialogs(wdDialogFileOpen).Show
q1 = ActiveDocument.Name
q2 = Left(q1, InStr(q1, ".") - 1) & "_THIN.txt"
Call newTextFile(q2)

np = Documents(q1).Paragraphs.Count
nmod = 400
Debug.Print "-----------------------------------------------"
Debug.Print np, nmod, Documents(q1).Name
Debug.Print "-----------------------------------------------"
Documents(q2).ActiveWindow.Visible = False
Documents(q1).ActiveWindow.Visible = False
For ip = 1 To np Step nmod
qq = Documents(q1).Paragraphs(ip).Range.Text
Documents(q2).Content.InsertAfter qq
Debug.Print 1 + Int(ip / nmod), ip
Next ip
np = Documents(q2).Paragraphs.Count

Debug.Print "-----------------------------------------------"
Debug.Print np, nmod, Documents(q2).Name
Debug.Print "-----------------------------------------------"
Documents(q1).ActiveWindow.Visible = True
Documents(q2).ActiveWindow.Visible = True
End Sub
Sub newTextFile(q2)
'
' newTextFile Macro
' Macro recorded 11/25/2006 by beauprej
'
Documents.Add Template:="Normal", NewTemplate:=False,
DocumentType:=0
ActiveDocument.SaveAs FileName:=q2, FileFormat:=wdFormatText, _
LockComments:=False, Password:="", AddToRecentFiles:=True,
WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False,
SaveAsAOCELetter:= _
False, Encoding:=1252, InsertLineBreaks:=False,
AllowSubstitutions:=False _
, LineEnding:=wdCRLF
End Sub

 

[Jay Freedman]

Hi Jim,

Every time it executes the line

qq = Documents(q1).Paragraphs(ip).Range.Text

VBA has to count the paragraphs in the document from 1 to the current
value of ip in order to locate the range. Word doesn't have a method
of locating a particular paragraph that's independent of the number of
paragraphs.

I think it would be quicker to make a copy of the original document
and then run a loop in which you skip one paragraph and delete the
next nmod - 1 paragraphs. It could go something like this:

Sub thin()
Dim oRgKeep As Range
Dim oRgZap As Range
Dim oDoc As Document
Const nmod = 400

Set oDoc = Documents.Add
oDoc.Range.FormattedText = Documents(q1).Range.FormattedText

Set oRgKeep = oDoc.Paragraphs(1).Range
Do
Set oRgZap = oRgKeep.Next(wdParagraph, 1)
oRgZap.MoveEnd wdParagraph, nmod - 2
oRgZap.Delete
Set oRgKeep = oRgKeep.Next(wdParagraph, 1)
Loop Until oRgKeep Is Nothing

oDoc.SaveAs FileName:=q2
End Sub

Note that the oRgZap.MoveEnd method extends the end of the range by
nmod - 2 paragraphs. That's because you want to remove nmod - 1
paragraphs, and one of those is already selected in the range.

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the
newsgroup so all may benefit.

 

[jvbeaupre]

Thanks. I'll try it tomorrow.

Wow, do we have different programming styles!

Jim