EmersonH.Com

On Error Resume Next

Dim WordSC As Object, pos As Integer
Set WordSC = CreateObject("Word.Basic")
WordSC.AppMinimize
WordSC.FileNewDefault
WordSC.EditSelectAll
WordSC.EditCut
WordSC.Insert Text1.text
WordSC.StartOfDocument
WordSC.ToolsSpelling
WordSC.EditSelectAll

Text1.text = WordSC.Selection

WordSC.FileCloseAll 2
WordSC.AppClose

Set WordSC = Nothing

If Mid(Text1.text, Len(Text1.text), 1) = Chr(13) Then
    Text1.text = Mid(Text1.text, 1, Len(Text1.text) - 1)
End If

pos = InStr(Text1.text, Chr(13))
Do While pos <> 0
    If Mid(Text1.text, pos + 1, 1) <> Chr(10) Then
        Text1.text = Mid(Text1.text, 1, pos) + Chr(10) + Mid(Text1.text, pos + 1)
    End If
    pos = InStr(pos + 1, Text1.text, Chr(13))
Loop

MsgBox "Spell Check Complete", vbInformation, "Spell Check"