删除 Microsoft Word 文档中所有拼写错误的单词

Question

I have numerous word documents with misspelt words that I'm hoping to batch delete. I've tried both of the solutions mentioned below, but they all seem to fail for me.

https://answers.microsoft.com/en-us/msoffice/forum/all/how-to-remove-all-misspelled-words-in-ms-word-at/608dbb5d-e719-4b5f-b44e-1b0542b66bd7

Sub DeleteSpellingErrors()
Dim rng As word.Range, i As Integer
If Selection.Range.Start = Selection.Range.End Then
    Set rng = ActiveDocument.Content
Else
    Set rng = Selection.Range
End If
If rng.SpellingErrors.Count > 0 Then
    For i = rng.SpellingErrors.Count To 1 Step -1
        rng.SpellingErrors(i).Delete
    Next
End If
End Sub

https://answers.microsoft.com/en-us/msoffice/forum/all/remove-all-misspelled-words-in-my-word-document/b686c318-c1fc-4d90-9e56-e922bb556abd

Using these macro codes causes my microsoft word to freeze (I'm using a 10th gen intel i7) indefinitely. Despite having waited for hours, there still hasn't been any progress. It seems to me like these codes only work for shorter documents, but because my word docs have more than 200 pages, it seems to freeze. Does anyone have any other code suggestions? Better yet, does anyone have any suggestions that allow me to batch delete misspelt words across multiple word docs? Currently, I am deleting misspelt words one document at a time. Thanks for any help!

Answer 1

Your code runs fine on my PC with a document that has 350 spelling errors.

If you have a 200+ page document it would be better to disable screen updating whilst your macro runs. I would also add a 'doevents' statement to the for loop so that at least the CTRL Break will halt the program. Initially you may also want to debug.print the count of errors to see how the macro is progressing.

Option Explicit

Sub DeleteSpellingErrors()

    Dim rng As Word.Range
    Dim i As Long
    
    If Selection.Range.Start = Selection.Range.End Then
    
        Set rng = ActiveDocument.StoryRanges(wdMainTextStory)
        
    Else
    
        Set rng = Selection.Range
        
    End If
    
    If rng.SpellingErrors.Count > 0 Then
    
        Application.ScreenUpdating = False
        Debug.Print "Total errors = ", rng.SpellingErrors.Count ' for debugging only
        
        For i = rng.SpellingErrors.Count To 1 Step -1
    
            DoEvents
            rng.SpellingErrors.Item(i).Delete
        
            Debug.Print i, rng.SpellingErrors.Count ' for debug only.  Note Count doesn't change
            
        Next
        
        Application.ScreenUpdating = True
        Application.ScreenRefresh
        
    End If
    
End Sub

Answer 2

Try if this code snippet is a bit faster:

    Sub DeleteSpellingErrors()
    Dim cnt As Long
    Dim cur As Range
    Dim doc As Document
    Set doc = ActiveDocument
    cnt = doc.Range.SpellingErrors.Count
    Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToFirst)
    For i = 1 To cnt
        cur.Select
        cur.Delete
        Debug.Print cnt & " " & i
        Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToNext)
        DoEvents
    Next
End Sub

Most probably you will have to re-run the procedure two or three times as I see that SpellingErrors.Count is not exact.

This re-run can be avoided with this other coding:

Sub DeleteSpellingErrors()
    Dim cnt, i As Long
    Dim cur, Last As Range
    Dim doc As Document
    Set doc = ActiveDocument
    cnt = doc.Range.SpellingErrors.Count
    Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToFirst)
    Set Last = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToLast)
    i = 1
    Do While cur <> Last
        cur.Select
        cur.Delete
        Debug.Print cnt & " " & i
        Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToNext)
        DoEvents
        i = i + 1
    Loop
End Sub

For testing purposes the document consisted of 107 pages with more than 3000 spelling errors and it took few minutes (about 3 or 4) of execution.