How to fix slowness when getting the spelling errors in Word VBA?

Question

I'm trying with the code below from here to list in other document the spelling errors of the active document. My actual file is about 7MB and 1400 pages and the number of spelling errors is about 2400.

What I see is the code is stuck each time the For Each loop runs the next item.

Is there a way to enhance the performance of this code? Thanks

Sub GetSpellingErrors()
    Dim DocThis As Document
    Dim iErrorCnt As Integer
    Dim J As Integer

    Set DocThis = ActiveDocument
    Documents.Add

    iErrorCnt = DocThis.SpellingErrors.Count
    For J = 1 To iErrorCnt
        Selection.TypeText Text:=DocThis.SpellingErrors(J)
        Selection.TypeParagraph
    Next J
End Sub

I alredy asked yesterday on Microsoft answers forum but I didn't get any answer.

Answer 1

With large documents there seem to be a large (beyond proportional) increase in the time it takes to go through the SpellingErrors collection, so you may see better performance if you instead check smaller chunks one after the other - for example comparing checking each paragraph in turn with checking the whole document in one shot:

Sub GetSpellingErrors()
    Dim DocThis As Document
    Dim i As Long, n As Long, nT As Long
    Dim t, errs As ProofreadingErrors
    Dim p As Paragraph, w

    Set DocThis = ActiveDocument

    'accessing errors for the whole document
    t = Timer
    Set errs = DocThis.Range.SpellingErrors
    n = errs.Count
    For i = 1 To n
        w = errs(i)
    Next i
    Debug.Print "Full doc", Timer - t & "sec", n & " Errors" '~250 sec

    'accessing errors by paragraph
    t = Timer
    For Each p In DocThis.Range.Paragraphs
        Set errs = p.Range.SpellingErrors
        n = errs.Count
        nT = nT + n 'sum the erors
        For i = 1 To n
            w = errs(i) 'just accessing the item...
        Next i
    Next p
    Debug.Print "By Paragraph", Timer - t & "sec", nT & " Errors" '~11 sec

End Sub

Results (# of pages vs. processing time):

Answer 2

Writing each spelling error to the output document iteratively is bound to slow things down. Try:

Sub GetSpellingErrors()
    Dim DocSrc As Document, DocTgt As Document
    Dim SpellErr, StrOut As String
    Set DocSrc = ActiveDocument
    For Each SpellErr In DocSrc.SpellingErrors
        StrOut = StrOut & SpellErr & vbCr
    Next
    Set DocTgt = Documents.Add
    DocTgt.Range.Text = StrOut
End Sub 

Answer 3

Tim Williams' answer is spot on. However, I took it two steps further and tested at the sentence and word level, with outstanding results. It was the same code as Tim's modified only for the new data types.

For a small document, the results were:

Full doc     65.75977 sec   401 Errors 
By Paragraph 12.07617 sec   401 Errors 
By Sentence   1.509766 sec  401 Errors
By Words      0.8984375 sec 402 Errors

For a large document (35,000 words, the size of a short novel), the results were:

By doc      ~9000       sec (21253 Errors)
By Paragraph  685.5898  sec  21253 Errors
By Sentence    95.34766 sec  21253 Errors
By Words       71.64648 sec  21306 Errors

The "By doc" test crashed, but it was last timed at about 2 1/2 hours and presumably not complete. The other tests speak for themselves.

One note, I've noticed that the proofreading list may become corrupt. I've seen evidence that an entry does not point to the next item but rather to a previous item. That means if you're going through the list, you may end up in an endless loop. There's no fixing it. Instead, I write code that records the current entry and then compares it to the next entry during the loop. If they're the same, then I skip ahead one. But there's no guarantee that the error points to the immediate item. It could point to one ten previously.