-
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...
-
Does this work, by Martin Liss:
Place in bas module:
Code:
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:
Code:
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