none
List of Surnames in MS Word Dictionary RRS feed

  • Question

  • I am looking for a way to ensure that every surname in my users' documents is flagged as misspelled so that they can redact it.  (They are using Office 2007.)  However, evidently many, many surnames are included in the dictionary so they are not found.  I could develop an exception list to make sure that they are flagged, but I don't know what names to include.  Using VBA, I have run the spell checker against the Census Bureau's list of 150,000 most common surnames using:

    for each x in activedocument.spellingerrors

    x.delete

    next x

    ...but after a while Word stops responding.  Does MS publish a list of surnames in the dictionary or is there any other way I could generate this list? 

    Thanks is advance.

     

    Saturday, January 15, 2011 2:40 PM

Answers

  • Hi Judgie

    I don't think there's any way to access the content of the spell checking dictionary Word/Office uses.

    Best approach would probably be the one you thought of with the census list. But you'll need to break it down into "bite-size" numbers of names. Word's spell check turns itself off if there are too many spelling errors in a single document - it's a memory thing. I can't tell you what a good size would be. I'd probably start testing with 1,000 names per document.


    Cindy Meister, VSTO/Word MVP
    • Marked as answer by Bessie Zhao Friday, January 21, 2011 10:28 AM
    Sunday, January 16, 2011 8:48 AM
    Moderator
  • Hi Judgie,

    Try the following macro. It references another document (named Checklist.doc - change the path & name to suit your needs) for a list of names (one per 'paragraph') to find and redact in the document(s) in the nominated folder:

    Sub Anonymiser()
    Application.ScreenUpdating = False
    Dim FileList As Variant, ChkDoc As Document, TestDoc As Document, FilePath As String, ChkList As String, j As Long
    'Load the strings from the reference doc into a text string to be used as an array.
    Set ChkDoc = Documents.Open("C:\Users\Judgie\Documents\Checklist.doc")
    ChkList = ChkDoc.Range.Text
    ChkDoc.Close False
    Set ChkDoc = Nothing
    'Get the path to the documents to process
    FilePath = InputBox("Please input the path to the documents to process", "Path to Files", ActiveDocument.Path)
    'Exit if the filepath is empty
    If FilePath = "" Then GoTo Done
    'Ensure the filepath ends with "\"
    If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
    'Get a list of all documents in the target folder
    FileList = Dir(FilePath & "*.doc", vbNormal)
    'Process each found file
    While FileList <> ""
      'Set TestDoc = Documents.Open(FilePath & FileList)
      With TestDoc.Range.Find
        .ClearFormatting
        With .Replacement
          .ClearFormatting
          .Font.Color = wdColorRed
        End With
        .MatchWildcards = True
        '.MatchWholeWord = True
        '.MatchCase = True
        'Process each word from the Check List
        For j = 0 To UBound(Split(ChkList, vbCr))
          'delete any honorifics (ie Dr Dr. Mr Mr. Mrs Mrs. Ms Ms. & Miss) separated by 'and'
          .Text = "[DM]{1}[irs.]{1,3} and [DM]{1}[irs.]{1,3} " & Split(ChkList, vbCr)(j)
          .Replacement.Text = "[NAMES REMOVED]"
          .Execute Replace:=wdReplaceAll
          'set-up the replacement text for all remaining strings
          .Replacement.Text = "[NAME REMOVED]"
          'delete possessive forms of reference names with honorifics (ie Dr Dr. Mr Mr. Mrs Mrs. Ms Ms. & Miss)
          .Text = "[DM]{1}[irs.]{1,3} " & Split(ChkList, vbCr)(j) & "'s"
          .Execute Replace:=wdReplaceAll
          'delete honorifics (ie Dr Dr. Mr Mr. Mrs Mrs. Ms Ms. & Miss) with reference names
          .Text = "[DM]{1}[irs.]{1,3} " & Split(ChkList, vbCr)(j)
          .Execute Replace:=wdReplaceAll
          '.MatchWildcards = False
          'delete possessive forms of reference names
          .Text = Split(ChkList, vbCr)(j) & "'s"
          .Execute Replace:=wdReplaceAll
          'delete any remaining reference names
          .Text = Split(ChkList, vbCr)(j)
          .Execute Replace:=wdReplaceAll
        Next
      End With
      TestDoc.Close True
      FileList = Dir()
    Wend
    'Clean up and exit
    Done:
    Set TestDoc = Nothing
    Application.ScreenUpdating = True
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]
    • Marked as answer by Bessie Zhao Friday, January 21, 2011 10:28 AM
    Thursday, January 20, 2011 1:26 AM

All replies

  • Hi Judgie

    I don't think there's any way to access the content of the spell checking dictionary Word/Office uses.

    Best approach would probably be the one you thought of with the census list. But you'll need to break it down into "bite-size" numbers of names. Word's spell check turns itself off if there are too many spelling errors in a single document - it's a memory thing. I can't tell you what a good size would be. I'd probably start testing with 1,000 names per document.


    Cindy Meister, VSTO/Word MVP
    • Marked as answer by Bessie Zhao Friday, January 21, 2011 10:28 AM
    Sunday, January 16, 2011 8:48 AM
    Moderator
  • Hi Cindy -

    I wanted to thank you for the response.  Looks like I am gonna be doing a lot of bite-sizing. 

    Danny

    Thursday, January 20, 2011 12:47 AM
  • Hi Judgie,

    Try the following macro. It references another document (named Checklist.doc - change the path & name to suit your needs) for a list of names (one per 'paragraph') to find and redact in the document(s) in the nominated folder:

    Sub Anonymiser()
    Application.ScreenUpdating = False
    Dim FileList As Variant, ChkDoc As Document, TestDoc As Document, FilePath As String, ChkList As String, j As Long
    'Load the strings from the reference doc into a text string to be used as an array.
    Set ChkDoc = Documents.Open("C:\Users\Judgie\Documents\Checklist.doc")
    ChkList = ChkDoc.Range.Text
    ChkDoc.Close False
    Set ChkDoc = Nothing
    'Get the path to the documents to process
    FilePath = InputBox("Please input the path to the documents to process", "Path to Files", ActiveDocument.Path)
    'Exit if the filepath is empty
    If FilePath = "" Then GoTo Done
    'Ensure the filepath ends with "\"
    If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
    'Get a list of all documents in the target folder
    FileList = Dir(FilePath & "*.doc", vbNormal)
    'Process each found file
    While FileList <> ""
      'Set TestDoc = Documents.Open(FilePath & FileList)
      With TestDoc.Range.Find
        .ClearFormatting
        With .Replacement
          .ClearFormatting
          .Font.Color = wdColorRed
        End With
        .MatchWildcards = True
        '.MatchWholeWord = True
        '.MatchCase = True
        'Process each word from the Check List
        For j = 0 To UBound(Split(ChkList, vbCr))
          'delete any honorifics (ie Dr Dr. Mr Mr. Mrs Mrs. Ms Ms. & Miss) separated by 'and'
          .Text = "[DM]{1}[irs.]{1,3} and [DM]{1}[irs.]{1,3} " & Split(ChkList, vbCr)(j)
          .Replacement.Text = "[NAMES REMOVED]"
          .Execute Replace:=wdReplaceAll
          'set-up the replacement text for all remaining strings
          .Replacement.Text = "[NAME REMOVED]"
          'delete possessive forms of reference names with honorifics (ie Dr Dr. Mr Mr. Mrs Mrs. Ms Ms. & Miss)
          .Text = "[DM]{1}[irs.]{1,3} " & Split(ChkList, vbCr)(j) & "'s"
          .Execute Replace:=wdReplaceAll
          'delete honorifics (ie Dr Dr. Mr Mr. Mrs Mrs. Ms Ms. & Miss) with reference names
          .Text = "[DM]{1}[irs.]{1,3} " & Split(ChkList, vbCr)(j)
          .Execute Replace:=wdReplaceAll
          '.MatchWildcards = False
          'delete possessive forms of reference names
          .Text = Split(ChkList, vbCr)(j) & "'s"
          .Execute Replace:=wdReplaceAll
          'delete any remaining reference names
          .Text = Split(ChkList, vbCr)(j)
          .Execute Replace:=wdReplaceAll
        Next
      End With
      TestDoc.Close True
      FileList = Dir()
    Wend
    'Clean up and exit
    Done:
    Set TestDoc = Nothing
    Application.ScreenUpdating = True
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]
    • Marked as answer by Bessie Zhao Friday, January 21, 2011 10:28 AM
    Thursday, January 20, 2011 1:26 AM