using word's spellcheck tool

[InCubus]

the spell check is working fine, but i want to keep word running the entire time my application is running. the problem i run into is that a new document is created everytime spellcheck is called. what i would like is for the document to be closed once the spell check is finished. here's the code i have thus far...:

Public Function SpellCheck(ByVal IncorrectText$) As String

'Dim oWord As Object, retText$
On Error Resume Next
Set oWord = CreateObject("Word.Basic")
' the next line was added to try keep things invisible
oWord.Visible = True
oWord.AppMinimize
oWord.FileNew
oWord.Insert IncorrectText
' open the spellchecker in word ...
oWord.ToolsSpelling
oWord.EditSelectAll
' done immediately before to minimize possibility of
' interaction with the clipboard
retText = oWord.Selection$()
SpellCheck = Left$(retText, Len(retText) - 1)
frmCustAds.ActiveControl.Text = SpellCheck
oWord.FileCloseAll 2
' following two lines have to do with invisibility
'oWord.AppClose
oWord.Visible = False
Set oWord = Nothing

End Function

is there an opposite function to CreateObject() that i could use to kill each document when this is called?

thank you in advance...

[JamesM]

Does this work, by Martin Liss:


Place in bas module:

Public Function mblnSpellCheck(ByVal strText As String, ByRef strCorrectText As String) As Boolean
'-------------------------------------------------------------------------------------------
'Check Spelling
'
'Input:
' strText - Text which which is To be spellchecked
'
'Output:
' strCorrectText - Text which has Correct spell
'
'Function returns True On success
'-------------------------------------------------------------------------------------------

    Const strPROCEDURE_NAME = "mblnSpellCheck"
    
    Dim objWord As Object 'Instance of the objWord Object
    Dim strRetText As String 'Holds the selected Text In objWord
    Dim strTextLines As String 'Holds the corrected text
    Static blnCheckInstance As Boolean 'True If it is already running
    Dim lSavePendingTimeout As Long
    Dim strSavependingMsgTitle As String
    Dim strSavePendingMsgText As String
    
    lSavePendingTimeout = App.OleRequestPendingTimeout
    strSavependingMsgTitle = App.OleRequestPendingMsgTitle
    strSavePendingMsgText = App.OleRequestPendingMsgText
 
    On Error GoTo ErrorRoutine
    
    If blnCheckInstance = True Then
        strCorrectText = strText
        mblnSpellCheck = True
        Exit Function
    End If
    
    blnCheckInstance = True
    
    'Create an instance of the objWord Object
    Set objWord = CreateObject("Word.Basic")
    
    App.OleRequestPendingMsgTitle = "Spell Check Tool from Word"
    App.OleRequestPendingMsgText = "Spell Check window is behind your Application"
    App.OleRequestPendingMsgText = App.OleRequestPendingMsgText & vbNewLine & "Please finish spell checking first"
    App.OleRequestPendingTimeout = 120000 'Set the Ole request timer To 2 minutes
    
    With objWord
        .AppMinimize 'Minimise the objWord Object
        .AppHide 'Hide the objWord Object
        .FileNew 'Open a New file document
        .Insert strText 'Insert the Incorrect Text that is passed In the parameter
        
        'Skip If any Error occurs On the Spell check Tool
        On Error Resume Next
        
        .ToolsSpelling 'Check the spelling
        .ToolsGrammar   'Check grammar
        
        'Reset the Error Handler To this Function Error handler
        On Error GoTo ErrorRoutine
        
        .EditSelectAll 'Select the all text In the document
        strRetText = .Selection$() 'return the selected text
        strTextLines = Left$(strRetText, Len(strRetText) - 1)
        .FileClose 2 'Close the File document
        .AppClose 'Close the Application
    End With
    
    'Reset To Default Value
    App.OleRequestPendingTimeout = lSavePendingTimeout
    App.OleRequestPendingMsgTitle = strSavependingMsgTitle
    App.OleRequestPendingMsgText = strSavePendingMsgText
    
    'Zap the Word Object
    Set objWord = Nothing
    
    'Replace the return key with New Line key
    strCorrectText = Replace(strTextLines, Chr(13), vbNewLine)
    
    DoEvents
    blnCheckInstance = False
    mblnSpellCheck = True
    Exit Function
    
ErrorRoutine:
    
    Me.MousePointer = vbNormal
    blnCheckInstance = False

End Function

Example of calling to validate a text box:

Private Sub txtTentArrsComm_Validate(Cancel As Boolean)

    Dim strCorrectText As String ' Holds the corrected return text
    
    'On Error GoTo txtTentArrsComm_ValidateError
    
    If ActiveControl.Name <> txtTentArrsComm.Name Then
        Exit Sub
    End If
    
    If mblnSpellCheck(txtTentArrsComm.Text, strCorrectText) = False Then
        Exit Sub
    End If
    
    txtTentArrsComm.Text = strCorrectText

End Sub