Advanced VB/Office Guru™ SpellChecker™

[RobDog888]

Gangsta Yoda

Description:
I wrote this to demonstrate how to take full advantage of MS Word's built in Spelling and Grammer checker. There
are a few other code examples that show how to do spell checking with Word but they are all using the same technique that
seems to have a few issues like showing the spell dialog behind your app, messing up the line breaks so you need to
apply a code fix to restore them, flashing window, etc.

What makes my spell checker different is that I use the actual spell/grammer checking dialog window and not invoking it by
coding the usual - "Document.CheckSpelling" which seems to cause the mentioned issues.

Since I use the dialog window I preset the type of spelling I wish to perform. Now you can make it dynamic by having a
spell options form in your app to allow the user to preset it to either Ignore words in UPPERCASE, urls, mixed words and
numbers, check grammer, and whether to show spelling suggestions, etc.

Requirements:
Microsoft Word
Versions 8.0 - 11.0 (97 - 2003)

'In a module (Module1.bas)
Option Explicit
'Copyright © 2005 by RobDog888 (VB/Office Guru™). All Rights reserved.
'
'Distribution: You can freely use this code in your own
'              applications provided that this copyright
'              is left unchanged, but you may not reproduce
'              or publish this code on any web site, online
'              service, or distribute as source on any
'              media without express permission.
'
'Early binding:
'Add a reference to MS Word xx.0 Object Library
'Modifications: none.
 
'Late binding:
'No references needed to any version of Word
'Modifications: Change object vars definitions (moApp & oDoc) to Object
'Change constants to their numeric equilivalents.
 
'Requirements:
'MS Word version 97 (8.0) - 2003 (11.0)
 
Public moApp As Word.Application
Private mbKillMe As Boolean
 
Public Property Get KillMe() As Boolean
    InitializeMe
    KillMe = mbKillMe
End Property
 
Public Property Let KillMe(Value As Boolean)
    mbKillMe = Value
End Property
 
Public Sub InitializeMe()
    On Error Resume Next
    '<INITIALIZE WORD>
    Set moApp = GetObject(, "Word.Application")
    If TypeName(moApp) <> "Nothing" Then
        Set moApp = GetObject(, "Word.Application")
    Else
        Set moApp = CreateObject("Word.Application")
        mbKillMe = True
    End If
End Sub
 
Public Function SpellMe(ByVal msSpell As String) As String
 
    On Error GoTo No_Bugs
 
    Dim oDoc As Word.Document
    Dim iWSE As Integer
    Dim iWGE As Integer
    Dim sReplace As String
    Dim lResp As Long
 
    If msSpell = vbNullString Then Exit Function
    InitializeMe
    Select Case moApp.Version
        Case "9.0", "10.0", "11.0"
            Set oDoc = moApp.Documents.Add(, , 1, True)
        Case "8.0"
            Set oDoc = moApp.Documents.Add
        Case Else
            MsgBox "Unsupported Version of Word.", vbOKOnly + vbExclamation, "VB/Office Guru™ SpellChecker™"
            Exit Function
    End Select
    Screen.MousePointer = vbHourglass
    App.OleRequestPendingTimeout = 999999
    oDoc.Words.First.InsertBefore msSpell
    iWSE = oDoc.SpellingErrors.Count
    iWGE = oDoc.GrammaticalErrors.Count
    '<CHECK SPELLING AND GRAMMER DIALOG BOX>
    If iWSE > 0 Or iWGE > 0 Then
        '<HIDE MAIN WORD WINDOW>
        moApp.Visible = False
        If (moApp.WindowState = wdWindowStateNormal) Or (moApp.WindowState = wdWindowStateMaximize) Then
            moApp.WindowState = wdWindowStateMinimize
        Else
            moApp.WindowState = wdWindowStateMinimize
        End If
        '</HIDE MAIN WORD WINDOW>
        '<PREP CHECK SPELLING OPTIONS DIALOG BOX (MODIFY TO YOUR PREFERENCES)>
        moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Application.Options.CheckGrammarWithSpelling = True
        moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Application.Options.SuggestSpellingCorrections = True
        moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Application.Options.IgnoreUppercase = True
        moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Application.Options.IgnoreInternetAndFileAddresses = True
        moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Application.Options.IgnoreMixedDigits = False
        moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Application.Options.ShowReadabilityStatistics = False
        '</PREP CHECK SPELLING OPTIONS DIALOG BOX (MODIFY TO YOUR PREFERENCES)>
        '<DO ACTUAL SPELL CHECKING>
        moApp.Visible = True
        moApp.Activate
        lResp = moApp.Dialogs(wdDialogToolsSpellingAndGrammar).Display
        '</DO ACTUAL SPELL CHECKING>
        If lResp < 0 Then
            moApp.Visible = True
            MsgBox "Corrections Being Updated!", vbOKOnly + vbInformation, App.ProductName
            Clipboard.Clear
            oDoc.Select
            oDoc.Range.Copy
            sReplace = Clipboard.GetText(1)
            '<FIX FOR POSSIBLE EXTRA LINE BREAK AT END OF TEXT>
            If (InStrRev(sReplace, Chr(13) & Chr(10))) = (Len(sReplace) - 1) Then
                sReplace = Mid$(sReplace, 1, Len(sReplace) - 2)
            End If
            '</FIX FOR POSSIBLE EXTRA LINE BREAK AT END OF TEXT>
            SpellMe = sReplace
        ElseIf lResp = 0 Then
            MsgBox "Spelling Corrections Have Been Canceled!", vbOKOnly + vbCritical, "VB/Office Guru™ SpellChecker"
            SpellMe = msSpell
        End If
    Else
        MsgBox "No Spelling Errors Found" & vbNewLine & "Or No Suggestions Available!", vbOKOnly + vbInformation, _
        "VB/Office Guru™ SpellChecker"
        SpellMe = msSpell
    End If
    '</CHECK SPELLING AND GRAMMER DIALOG BOX>
    oDoc.Close False
    Set oDoc = Nothing
    '<HIDE WORD IF THERE ARE NO OTHER INSTANCES>
    If KillMe = True Then
        moApp.Visible = False
    End If
    '</HIDE WORD IF THERE ARE NO OTHER INSTANCES>
    Screen.MousePointer = vbNormal
    Exit Function
No_Bugs:
    If Err.Number = "91" Then
        Resume Next
    ElseIf Err.Number = "462" Then
        MsgBox "Spell Checking Is Temporary Un-Available!" & vbNewLine & "Try Again After Program Re-Start.", _
        vbOKOnly + vbInformation, "ActiveX Server Not Responding"
        Screen.MousePointer = vbNormal
    ElseIf Err.Number = 429 Then
        Set moApp = Nothing
        Resume Next
    Else
        MsgBox Err.Number & " " & Err.Description, vbOKOnly + vbInformation, App.ProductName
        Screen.MousePointer = vbNormal
    End If
End Function
 
'*********************************************************
 
'Example usage:
'Behind a form (Form1)
'
'Add a single or multi-line textbox to your form
'Add a command button (Command1) to invoke the spell checking.
Option Explicit
 
Private Sub Command1_Click()
    '<SPELL CHECK>
    Text1.Text = SpellMe(Text1.Text)
End Sub
 
Private Sub Form_Load()
    '<CALL THE SPELLME INITIALIZATION PROCEDURE BEFORE ANY USE>
    InitializeMe
End Sub
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If KillMe = True Then
        moApp.Quit False
    End If
    Set moApp = Nothing
End Sub