K
Keith
Greeting all-
I wrote the following VBA code for a graduate student who is using Word to
collect research data. I just heard from her that manually invoking
spellcheck interrupts/stops the macro, resulting in lost data. I haven't
programmed a lot in Word, so I wasn't aware of this problem- are there any
common workarounds to keep the macro "alive" and collecting data in the
background during and after a spellcheck? I've included all of the code
below, in case there is anything in the existing code that should be tweaked
to support a solution.
The code captures the cursor position, current time, and 20s interval tag to
a text file, number of chars in the file, and the number of spelling errors
so far. Apparently, it is when the subjects invoke the spellchecker directly
that the macro stops.
Many thanks,
Keith
Sub Document_Open()
'can't check if SSID file exists- error would warn the subject
'Open SubjectID Text File
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\SubjectID.txt", ForReading, TristateFalse)
SSID = f.readline
f.Close
'Will move this later, maybe to an add-in
'Identify subject ID for this session and use in filename
' SID = InputBox("This will eventually be done before the subject enters
the room and the file is opened" & Chr(13) & Chr(13) & _
' "Please enter the subjectID:", "Pre-Session Subject Information")
' 'Verify that SID was given
' If Len(SID) = 0 Then
' MsgBox ("Subject ID not entered- session code will now terminate."
& Chr(13) & Chr(13) & _
' "To run a real session, close this file, start a new file, and
enter a Subject ID")
' Else
'Let Word know that we will be using the FileSystemObject in our
code
'Set fs = CreateObject("Scripting.FileSystemObject")
'Determine file name for this session
TimeExtension = CheckTime()
MyFileName = SSID & TimeExtension
'Create the file (or at least the name)
Set a = fs.CreateTextFile("c:\" & MyFileName & ".txt")
a.Close
'capture the actual session start time, for future reference
SessionStartTime = Now()
'set the first interval as 20 seconds from session start time
NextInterval = SessionStartTime + TimeValue("00:00:20")
'set the code to run at the Next Interval
Every20Seconds
'End If
End Sub
'*** In Module 1***
Public NextInterval
Public a 'for filesystem object
Public MyFileName
Public SessionStartTime
Sub Every20Seconds()
Application.OnTime When:=NextInterval, Name:="AngiesData"
End Sub
Sub AngiesData()
'Let Word know that we will be using the FileSystemObject in our code
Set fs = CreateObject("Scripting.FileSystemObject")
'create lMyCharCount variable to hold the character count
Dim lMyCharCount As Long
'create a range variable to hold the document minus last word
Dim rgeDoc As Range
'create a range variable to find current cursor location
Dim rgeLoc As Range
'create lmyErr to hold the spelling error count
'has to be a variant to hold the actual errors as well as error count
Dim lmyErr As Variant
'Calculate elapsed time for current interval
ElapsedTime = Format(NextInterval - SessionStartTime, "hh:mm:ss")
'reset the timer for the next interval
NextInterval = NextInterval + TimeValue("00:00:20")
'retrieve the number of characters in the document
'this also may include paragraph formatting and hard returns
lMyCharCount = ActiveDocument.Characters.Count
Set rgeLoc = ActiveDocument.Range
rgeLoc.End = Selection.Range.End
CurrLoc = (ActiveDocument.Characters.Count - 1) -
rgeLoc.Characters.Count
'check to see how many spelling errors are in the active document minus
the last word
'set the range to be checked to the whole document minus the last word
Set rgeDoc = ActiveDocument.Range
rgeDoc.MoveEnd wdWord, -2 '2 because last pp mark counts as a word
lmyErr = rgeDoc.SpellingErrors.Count
'create an array of the spelling errors in the active document
Set myErrors = rgeDoc.SpellingErrors
'Send data to text data file
Set a = fs.OpenTextFile("c:\" & MyFileName & ".txt", 8, TristateFalse)
a.WriteLine ((Now) & "," & ElapsedTime & "," & lmyErr & "," &
lMyCharCount & "," & CurrLoc)
a.Close
' For Each lmyErr In myErrors
' MsgBox lmyErr.Text
' Next
'set the macro to run at the next interval
Every20Seconds
End Sub
Function CheckTime()
hrs = Hour(Now)
If Len(hrs) = 1 Then hrs = "0" & hrs
mins = Minute(Now)
If Len(mins) = 1 Then mins = "0" & hrs
secs = Second(Now)
If Len(secs) = 1 Then secs = "0" & hrs
CheckTime = hrs & mins & secs
End Function
I wrote the following VBA code for a graduate student who is using Word to
collect research data. I just heard from her that manually invoking
spellcheck interrupts/stops the macro, resulting in lost data. I haven't
programmed a lot in Word, so I wasn't aware of this problem- are there any
common workarounds to keep the macro "alive" and collecting data in the
background during and after a spellcheck? I've included all of the code
below, in case there is anything in the existing code that should be tweaked
to support a solution.
The code captures the cursor position, current time, and 20s interval tag to
a text file, number of chars in the file, and the number of spelling errors
so far. Apparently, it is when the subjects invoke the spellchecker directly
that the macro stops.
Many thanks,
Keith
Sub Document_Open()
'can't check if SSID file exists- error would warn the subject
'Open SubjectID Text File
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\SubjectID.txt", ForReading, TristateFalse)
SSID = f.readline
f.Close
'Will move this later, maybe to an add-in
'Identify subject ID for this session and use in filename
' SID = InputBox("This will eventually be done before the subject enters
the room and the file is opened" & Chr(13) & Chr(13) & _
' "Please enter the subjectID:", "Pre-Session Subject Information")
' 'Verify that SID was given
' If Len(SID) = 0 Then
' MsgBox ("Subject ID not entered- session code will now terminate."
& Chr(13) & Chr(13) & _
' "To run a real session, close this file, start a new file, and
enter a Subject ID")
' Else
'Let Word know that we will be using the FileSystemObject in our
code
'Set fs = CreateObject("Scripting.FileSystemObject")
'Determine file name for this session
TimeExtension = CheckTime()
MyFileName = SSID & TimeExtension
'Create the file (or at least the name)
Set a = fs.CreateTextFile("c:\" & MyFileName & ".txt")
a.Close
'capture the actual session start time, for future reference
SessionStartTime = Now()
'set the first interval as 20 seconds from session start time
NextInterval = SessionStartTime + TimeValue("00:00:20")
'set the code to run at the Next Interval
Every20Seconds
'End If
End Sub
'*** In Module 1***
Public NextInterval
Public a 'for filesystem object
Public MyFileName
Public SessionStartTime
Sub Every20Seconds()
Application.OnTime When:=NextInterval, Name:="AngiesData"
End Sub
Sub AngiesData()
'Let Word know that we will be using the FileSystemObject in our code
Set fs = CreateObject("Scripting.FileSystemObject")
'create lMyCharCount variable to hold the character count
Dim lMyCharCount As Long
'create a range variable to hold the document minus last word
Dim rgeDoc As Range
'create a range variable to find current cursor location
Dim rgeLoc As Range
'create lmyErr to hold the spelling error count
'has to be a variant to hold the actual errors as well as error count
Dim lmyErr As Variant
'Calculate elapsed time for current interval
ElapsedTime = Format(NextInterval - SessionStartTime, "hh:mm:ss")
'reset the timer for the next interval
NextInterval = NextInterval + TimeValue("00:00:20")
'retrieve the number of characters in the document
'this also may include paragraph formatting and hard returns
lMyCharCount = ActiveDocument.Characters.Count
Set rgeLoc = ActiveDocument.Range
rgeLoc.End = Selection.Range.End
CurrLoc = (ActiveDocument.Characters.Count - 1) -
rgeLoc.Characters.Count
'check to see how many spelling errors are in the active document minus
the last word
'set the range to be checked to the whole document minus the last word
Set rgeDoc = ActiveDocument.Range
rgeDoc.MoveEnd wdWord, -2 '2 because last pp mark counts as a word
lmyErr = rgeDoc.SpellingErrors.Count
'create an array of the spelling errors in the active document
Set myErrors = rgeDoc.SpellingErrors
'Send data to text data file
Set a = fs.OpenTextFile("c:\" & MyFileName & ".txt", 8, TristateFalse)
a.WriteLine ((Now) & "," & ElapsedTime & "," & lmyErr & "," &
lMyCharCount & "," & CurrLoc)
a.Close
' For Each lmyErr In myErrors
' MsgBox lmyErr.Text
' Next
'set the macro to run at the next interval
Every20Seconds
End Sub
Function CheckTime()
hrs = Hour(Now)
If Len(hrs) = 1 Then hrs = "0" & hrs
mins = Minute(Now)
If Len(mins) = 1 Then mins = "0" & hrs
secs = Second(Now)
If Len(secs) = 1 Then secs = "0" & hrs
CheckTime = hrs & mins & secs
End Function
