<!--
+---------------------------------------------------------------------------+
VB-WORLD Forums - Tagging Scripts 1.0
Martin Liss
Integrated with RobDog's Advanced VB/Office Guru SpellChecker
[url]http://www.vbforums.com/showthread.php?t=350402[/url]
Function: Spell Checker v2.0
Description: This script uses Microsoft Word to check the spelling in
posts. Word is assumed to be present.
+---------------------------------------------------------------------------+
-->
<script type="text/vbscript">
Const wdWindowStateNormal=0
Const wdWindowStateMaximize=1
Const wdWindowStateMinimize=2
Const wdDialogToolsSpellingAndGrammar=828
Dim objWindow
Dim objSource
Dim objSelect
Dim objSelectRange
Set objWindow = window.external.menuArguments
Set objSource = objWindow.event.srcElement
Set oDocument = objWindow.document
Set objSelect = oDocument.selection
Set objSelectRange = objSelect.createRange()
If objSource.tagName = "TEXTAREA" And Len(objSelectRange.text)>0 Then
Dim sc: Set sc = New SpellChecker
objSelectRange.text=sc.CheckThis(objSelectRange.text)
Set sc=Nothing
End If
Class SpellChecker
Dim moApp, mbKillMe
Public Property Get KillMe()
KillMe = mbKillMe
End Property
Public Property Let KillMe(Value)
mbKillMe = Value
End Property
Private Sub Class_Initialize()
On Error Resume Next
'<INITIALIZE WORD>
Set moApp = GetObject(, "Word.Application")
'window.alert(TypeName(moApp))
If TypeName(moApp) = "Empty" Or TypeName(moApp) = "Nothing" Then
' Word is not currently running.
' launch it and set flag to close it when done
Set moApp = CreateObject("Word.Application")
mbKillMe = True
End If
End Sub
Private Sub Class_Terminate()
If KillMe = True Then
moApp.Quit False
End If
Set moApp=Nothing
End Sub
Public Function CheckThis(ByVal msSpell)
On Error GoTo 0 'Resume Next
Dim oDoc 'As Word.Document
Dim iWSE 'As Integer
Dim iWGE 'As Integer
Dim sReplace 'As String
Dim lResp 'As Long
If msSpell = "" Then Exit Function
'window.alert(TypeName(moApp) & vbNewLine & moApp.Version)
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
window.alert("Unsupported version of word.")' & moApp.Version)
Exit Function
End Select
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
window.alert("Applying corrections!")
Call Window.ClipboardData.SetData("Text","") 'Clipboard.Clear
oDoc.Select
oDoc.Range.Copy
sReplace = Window.ClipboardData.GetData("Text") '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>
CheckThis = sReplace
ElseIf lResp = 0 Then
window.alert("Spelling corrections have been canceled!")
CheckThis = msSpell
End If
Else
window.alert("No spelling errors found or no suggestions available!")
CheckThis = 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>
If Err.Number <> 0 Then
If Err.Number = "91" Then
'Resume Next
ElseIf Err.Number = "462" Then
window.alert("Spell checking is temporary un-available! Try again after program re-start.")
ElseIf Err.Number = 429 Then
Set moApp = Nothing
'Resume Next
Else
window.alert(Err.Number & " " & Err.Description)
End If
End If
End Function
End Class
</script>