VB6 - Need spell checker in Word to be visible during runtime

Here is what I get:

From your picture it looks like "test" is spelled correctly, so did it partially work?

yes it did

Try just deleting the yellow line of code.

The first time it worked.  When I clicked it again I get the clipboard error and it removes the content:

Please describe in detail, step by step, what I should do to reproduce that error.

Ok I reproduced the error.

When I put the string "test" in the field and push Spell Check, the spell checker pops up and I fix it without issue.

When I push the Spell Check again, then the error pops up Error 521 and I lost whatever is in the Textbox.  FYI, I changed one of the lines to reflect the name of my form rather than Form1

Here is my current code.

    
    On Error GoTo ErrorRoutine
    ' Create a Word document object
    If TypeName(objWord) <> "Nothing" Then
        ' Word is already open
        Set objWord = GetObject(, "Word.Application")
    Else
        ' Create an instance of Word
        Set objWord = CreateObject("Word.Application")
    End If
    CoAllowSetForegroundWindow objWord, 0

    Select Case objWord.Version
        'Office 2000 and later
        Case "9.0", "10.0", "11.0", "14.0", "15.0"
            Set objDoc = objWord.Documents.Add(, , 1, True)
        'Office 97
        Case "8.0"
            Set objDoc = objWord.Documents.Add
        Case Else
            MsgBox "Sorry but your version of Word seems to be " & QUOTE & objWord.Version _
                   & QUOTE & " and that version is not currently supported.", vbOKOnly + vbExclamation, "Spelling Checker"
            Exit Function
    End Select

    Set objDoc = objWord.Documents.Add
    objWord.WindowState = 2 ' wdWindowStateMinimize
    objWord.Visible = True
    
    objWord.Activate
    ' Assign the text to the document and check spelling
    With objDoc
        .Content.Paste
        .Activate
        .CheckSpelling
        ' After the user has made changes, use the clipboard to
        ' transfer the contents back to the text box
        .Content.Copy
        CheckSpelling = Clipboard.GetText(vbCFText)
        ' Close the document and exit Word
        .Saved = True
        strResult = Left(.Content, Len(.Content) - 1)
        ' Reformat carriage returns
        strResult = Replace(strResult, Chr(13), Chr(13) & Chr(10))
        
        If AddRegistration.Text1.Text = strResult Then
            ' There were no errors, so let the user know that the spelling was checked
            MsgBox "No changes made", vbInformation + vbOKOnly, "Spelling Checker"
        End If
       .Close
    End With
    
    Set objDoc = Nothing
    objWord.Visible = False
    objWord.Quit
    Set objWord = Nothing
    Exit Function
    
ErrorRoutine:
    'CheckSpelling = Clipboard.GetText(vbCFText)
    Screen.MousePointer = vbNormal
    Select Case err 'lngError
        Case 91, 429
            MsgBox "MS Word cannot be found!", vbExclamation
        Case Else
            MsgBox "Error: " & err & " - " & Error$(err), vbExclamation, App.ProductName
    End Select
End Function

Select allOpen in new window

I can't reproduce the error but it's most likely this line.

        CheckSpelling = Clipboard.GetText(vbCFText)

Try changing it to

        CheckSpelling = Clipboard.GetText

Do you know how to use Debug? If so then step through the code on the second attempt and verify that that's the line that causes the error. If not then please read my Using the VB6 Debugger: article.

So this has been tough for me because it has been working well and every so often I get the error.  I will have to do more debugging this weekend and see if I can see what is causing it.

I guess the biggest concern I have is that the user will lose everything if there is an error.  Would it be possible to make sure the user doesn't lose what they typed in the event of an error?

I made two changes. Line 44 was added to hopefully prevent your 521 error from happening, and line 52 was changed so that the name of the form does not need to be "Form1". If that works I can possible modify that line further so that the textbox does not need to be named "Text1". To do so you would need to add a value to the textbox's Tag property and tell me what you set it to.

Public Function CheckSpelling() As String
    Dim objWord As Object
    Dim objDoc As Object 'Word.Document
    Dim strResult As String

    Const QUOTE = """"
    
    On Error GoTo ErrorRoutine
    ' Create a Word document object
    If TypeName(objWord) <> "Nothing" Then
        ' Word is already open
        Set objWord = GetObject(, "Word.Application")
    Else
        ' Create an instance of Word
        Set objWord = CreateObject("Word.Application")
    End If
    CoAllowSetForegroundWindow objWord, 0

    Select Case objWord.version
        'Office 2000 and later
        Case "9.0", "10.0", "11.0", "14.0", "15.0"
            Set objDoc = objWord.Documents.Add(, , 1, True)
        'Office 97
        Case "8.0"
            Set objDoc = objWord.Documents.Add
        Case Else
            MsgBox "Sorry but your version of Word seems to be " & QUOTE & objWord.version _
                   & QUOTE & " and that version is not currently supported.", vbOKOnly + vbExclamation, "Spelling Checker"
            Exit Function
    End Select

    Set objDoc = objWord.Documents.Add
    objWord.WindowState = 2 ' wdWindowStateMinimize
    objWord.Visible = True

    objWord.Activate
    ' Assign the text to the document and check spelling
    With objDoc
        .content.Paste
        .Activate
        .CheckSpelling
        ' After the user has made changes, use the clipboard to
        ' transfer the contents back to the text box
        Clipboard.Clear
       .content.Copy
        CheckSpelling = Clipboard.GetText
        ' Close the document and exit Word
        .Saved = True
        strResult = Left(.content, Len(.content) - 1)
        ' Reformat carriage returns
        strResult = Replace(strResult, Chr(13), Chr(13) & Chr(10))
        If Forms(0).Text1.Text = strResult Then
            ' There were no errors, so let the user know that the spelling was checked
            MsgBox "No changes made", vbInformation + vbOKOnly, "Spelling Checker"
        End If
       .Close
    End With
    
    Set objDoc = Nothing
    objWord.Visible = False
    objWord.Quit
    Set objWord = Nothing
    Exit Function
    
ErrorRoutine:
    Screen.MousePointer = vbNormal
    Select Case Err
        Case 91, 429
            MsgBox "MS Word cannot be found!", vbExclamation
        Case Else
            MsgBox "Error: " & Err & " - " & Error$(Err), vbExclamation, App.ProductName
    End Select
End Function

Select allOpen in new window

I've never used tags really.  What if I tag the textbox as "Background"

This assumes that the Tag for the textbox you want to spellcheck is Background.

Private Sub Command1_Click()
    Dim ctl As Control
    
    Clipboard.Clear
    For Each ctl In Forms(0).Controls
        If TypeOf ctl Is TextBox Then
            If ctl.Tag = "Background" Then
                Clipboard.SetText ctl.Text
                ctl.Text = CheckSpelling()
                Exit For
            End If
        End If
    Next

End Sub

Select allOpen in new window

Public Function CheckSpelling() As String
    Dim objWord As Object
    Dim objDoc As Object 'Word.Document
    Dim strResult As String
    Dim ctl As Control

    Const QUOTE = """"
    
    On Error GoTo ErrorRoutine
    ' Create a Word document object
    If TypeName(objWord) <> "Nothing" Then
        ' Word is already open
        Set objWord = GetObject(, "Word.Application")
    Else
        ' Create an instance of Word
        Set objWord = CreateObject("Word.Application")
    End If
    CoAllowSetForegroundWindow objWord, 0

    Select Case objWord.version
        'Office 2000 and later
        Case "9.0", "10.0", "11.0", "14.0", "15.0"
            Set objDoc = objWord.Documents.Add(, , 1, True)
        'Office 97
        Case "8.0"
            Set objDoc = objWord.Documents.Add
        Case Else
            MsgBox "Sorry but your version of Word seems to be " & QUOTE & objWord.version _
                   & QUOTE & " and that version is not currently supported.", vbOKOnly + vbExclamation, "Spelling Checker"
            Exit Function
    End Select

    Set objDoc = objWord.Documents.Add
    objWord.WindowState = 2 ' wdWindowStateMinimize
    objWord.Visible = True

    objWord.Activate
    ' Assign the text to the document and check spelling
    With objDoc
        .content.Paste
        .Activate
        .CheckSpelling
        ' After the user has made changes, use the clipboard to
        ' transfer the contents back to the text box
        Clipboard.Clear
       .content.Copy
        CheckSpelling = Clipboard.GetText
        ' Close the document and exit Word
        .Saved = True
        strResult = Left(.content, Len(.content) - 1)
        ' Reformat carriage returns
        strResult = Replace(strResult, Chr(13), Chr(13) & Chr(10))
        For Each ctl In Forms(0).Controls
            If TypeOf ctl Is TextBox Then
                If ctl.Tag = "Background" Then
                    If ctl.Text = strResult Then
                        ' There were no errors, so let the user know that the spelling was checked
                        MsgBox "No changes made", vbInformation + vbOKOnly, "Spelling Checker"
                        Exit For
                    End If
                End If
            End If
        Next
       .Close
    End With
    
    Set objDoc = Nothing
    objWord.Visible = False
    objWord.Quit
    Set objWord = Nothing
    Exit Function
    
ErrorRoutine:
    Screen.MousePointer = vbNormal
    Select Case Err
        Case 91, 429
            MsgBox "MS Word cannot be found!", vbExclamation
        Case Else
            MsgBox "Error: " & Err & " - " & Error$(Err), vbExclamation, App.ProductName
    End Select
End Function

Select allOpen in new window

Hmm.  When I run the code on the command button, nothing at all happens.  Any ideas?

Please attach a zip file that contains your project.

Found the problem.  On line 5 in Command1 and on line 53 in the module, it was not executing because the name of my form was different from yours.  After I changed the name to the name of my form, it worked.  So far things are looking good.  Thanks Martin.

That's good. My use of Forms(0) was in response to your "Is there a way to change that so that I can execute it from any form field from any form" question so let me explain. VB6 keeps track of the forms that are open in a collection called 'Forms' and Forms(0) refers to the first one opened and Forms(1) refers to the second, etc. That allows you to do things like

' Display the name of the second form opened
Msgbox Forms(1).Name
' Display the count of open forms
Msgbox Forms.Count

Select allOpen in new window

If my use of Forms(0) didn't work for you I assume it was because more than one form was open and the one where you wanted to do the spellchecking was not the first one opened.

Ah.  My program opens a splash scree. And then a home screen and then a login screen.  So if I run thru a routine of Form(0) thru like Form(3) then it should find it?

Yes something like that could work, but it's simpler to just change Forms(0) to the name of the form as you have done.

Yes, I agree.  I’ll have to think about this one.

I believe this will work no matter what the form is named.

In a module

Option Explicit

Declare Function CoAllowSetForegroundWindow Lib "ole32.dll" (ByVal pUnk As Object, ByVal lpvReserved As Long) As Long
Public gfrmIndex As Integer

Public Function CheckSpelling() As String
    Dim objWord As Object
    Dim objDoc As Object 'Word.Document
    Dim strResult As String
    Dim ctl As Control

    Const QUOTE = """"
    
    On Error GoTo ErrorRoutine
    ' Create a Word document object
    If TypeName(objWord) <> "Nothing" Then
        ' Word is already open
        Set objWord = GetObject(, "Word.Application")
    Else
        ' Create an instance of Word
        Set objWord = CreateObject("Word.Application")
    End If
    CoAllowSetForegroundWindow objWord, 0

    Select Case objWord.version
        'Office 2000 and later
        Case "9.0", "10.0", "11.0", "14.0", "15.0"
            Set objDoc = objWord.Documents.Add(, , 1, True)
        'Office 97
        Case "8.0"
            Set objDoc = objWord.Documents.Add
        Case Else
            MsgBox "Sorry but your version of Word seems to be " & QUOTE & objWord.version _
                   & QUOTE & " and that version is not currently supported.", vbOKOnly + vbExclamation, "Spelling Checker"
            Exit Function
    End Select

    Set objDoc = objWord.Documents.Add
    objWord.WindowState = 2 ' wdWindowStateMinimize
    objWord.Visible = True

    objWord.Activate
    ' Assign the text to the document and check spelling
    With objDoc
        .content.Paste
        .Activate
        .CheckSpelling
        ' After the user has made changes, use the clipboard to
        ' transfer the contents back to the text box
        Clipboard.Clear
       .content.Copy
        CheckSpelling = Clipboard.GetText
        ' Close the document and exit Word
        .Saved = True
        strResult = Left(.content, Len(.content) - 1)
        ' Reformat carriage returns
        strResult = Replace(strResult, Chr(13), Chr(13) & Chr(10))
        For Each ctl In Forms(gfrmIndex).Controls
            If TypeOf ctl Is TextBox Then
                If ctl.Tag = "Background" Then
                    If ctl.Text = strResult Then
                        ' There were no errors, so let the user know that the spelling was checked
                        MsgBox "No changes made", vbInformation + vbOKOnly, "Spelling Checker"
                        Exit For
                    End If
                End If
            End If
        Next
       .Close
    End With
    
    Set objDoc = Nothing
    objWord.Visible = False
    objWord.Quit
    Set objWord = Nothing
    Exit Function
    
ErrorRoutine:
    Screen.MousePointer = vbNormal
    Select Case Err
        Case 91, 429
            MsgBox "MS Word cannot be found!", vbExclamation
        Case Else
            MsgBox "Error: " & Err & " - " & Error$(Err), vbExclamation, App.ProductName
    End Select
End Function

Select allOpen in new window

In the command button

Private Sub Command1_Click()
    Dim ctl As Control
    Dim intIndex As Integer
    Dim frm As Form

    For Each frm In Forms
        If frm.Name = Me.Name Then
            Exit For
        End If
        gfrmIndex = gfrmIndex + 1
    Next
    
    Clipboard.Clear
    
    For Each ctl In Me.Controls
        If TypeOf ctl Is TextBox Then
            If ctl.Tag = "Background" Then
                Clipboard.SetText ctl.Text
                ctl.Text = CheckSpelling()
                Exit For
            End If
        End If
    Next

End Sub

Select allOpen in new window

The code you sent works the first time.  When I click it a second time, I get a subscript our of range that seems to be in the module around this line.

BTW, thank you for all your help

You're welcome.

I ran it, corrected a spelling and ran it a second time correcting a spelling with no errors. What does it tell you when it stops at that line and you place your cursor over gfrmIndex?

It shows 6

Works like a champ now!  Thanks Martin

Great!

Again, thanks for your diligence and patience in helping me