After receiving years of email, feedback, and support for my first published article on SearchDomino, Using MSAgent to vocally/audibly read e-mail aloud, I discovered that implementing the code on a Win2000 system required more than a few changes, and I thought I might share that updated and commented code with all my good friends here.
What this code does is to hijack Clippy....ah, err... I mean, utilize Microsoft Agent (MSAgent), to audibly read any text string fed to it aloud. Having no need to display the agents' animation, we send Clippy to the netherregions of negative coordinates, enabling users to hear the agents' "voice" without subjecting them to MSAgents' animation.
Insofar as MSAgent is automatically installed with every modern Windows OS, its a pretty sure thing that this code *should* run on nearly all Wintel boxes in your organization. You may need to reorient the location of the "Merlin.acs" file to match your configuration, though.
Additionally, beyond the code and the Merlin.asc location, there is one last piece necessary for this to operate -- an MSAgent object must be placed on the form on which the code is to run. Select whitespace on your form, and select 'Create/Object' in Designer. Switch the first option from 'Object' to 'Control', and in the Object TYpe selection list search out the "Microsoft Agent Control 2.0", which will place a small icon representing the object. You can hide this object using the Text Properties box.
As in my original post, you'll need to cobble together your own @ReplaceSubstring and @Contains scripts; SearchDomino.com has more than a few posts concerning both. And, as before, I'm still searching for a more elegant means of determining where a response post ends and its quoted original begins; currently, we're testing for a "----forwards" string, but I'd be pleased if anyone might suggest a better way.
Sub Click(Source As Button)
Const NOTESMACRO$ = "@Attachments"
On Error Goto errHandler
Dim nw As New NotesUIWorkspace
Dim ns As New NotesSession
Dim uidoc As NotesUIDocument
Dim rtItem As NotesRichTextItem
Dim varApp As Variant
Dim txtBody As String, txtDate As String
Dim strYear As String, strDay As String,
strMonth As String, strDate As String,
strHour As String, strMinute As String,
strMeridian As String, strWkday As String
Dim nnName As NotesName
Dim dtDate As NotesDateTime
'---------------------------------------------------
Set variables
Set uidoc = nw.CurrentDocument
Set doc = uidoc.Document
Set rtItem = doc.GetFirstItem ( "Body" )
Set varApp=uidoc.GetObject("Microsoft Agent Control 2.0")
'---------------------------------------------------
Correct [From] field Naming
varAtt = Evaluate ( NOTESMACRO$, doc )
If atContains ( doc.From (0), "@" ) Then
txtFrom = doc.From (0)
Else
Set nnName = New NotesName ( doc.From (0))
txtFrom = nnName.Common
End If
txtSubj = doc.Subject (0)
txtBody = Lcase ( Cstr ( rtItem.Text ) )
txtDate = Datevalue(doc.dtFullTextDate (0))
'---------------------------------------------------
Breakout txtDate & time to conversational values
Set dtDate = New NotesDateTime ( doc.dtFullTextdate(0))
strYear = Cstr (Year ( dtDate.Dateonly ))
strDay = Cstr (Day ( dtDate.Dateonly ))
strMonth = Cstr (Month (dtDate.Dateonly ))
strHour = Cstr (Hour ( dtDate.Timeonly ))
strMinute = Cstr (Minute ( dtDate.Timeonly ))
strMeridian = Mid ( dtDate.TimeOnly, 10, 2)
If Left (strHour,1) = "0" Then
strHour = Right ( strHour, 1 )
End If
Dim strSuffix As String, strFlag As String
strFlag = (Right ( strDay, 1 ))
If strDay = 11 Or strDay = 12 Or strDay = 13 Then
strSuffix = "th"
Elseif strFlag = "1" Then
strSuffix = "st"
Elseif strFlag = "2" Then
strSuffix = "nd"
Elseif strFlag = "3" Then
strSuffix = "rd"
Else
strSuffix = "th"
End If
If Left (strDay,1) = "0" Then
strDay = Right ( strDay, 1 )
End If
Select Case strMinute
Case "00"
strMinute = "O Clock"
Case "30"
strMinute = "Thirty"
End Select
Select Case Weekday ( dtDate.DateOnly )
Case 1
strWkday = "Sunday"
Case 2
strWkday = "Monday"
Case 3
strWkday = "Tuesday"
Case 4
strWkday = "Wednesday"
Case 5
strWkday = "Thursday"
Case 6
strWkday = "Friday"
Case 7
strWkday = "Saturday"
End Select
Select Case strMonth
Case "1"
strMonth = "January"
Case "2"
strMonth = "February"
Case "3"
strMonth = "March"
Case "4"
strMonth = "April"
Case "5"
strMonth = "May"
Case "6"
strMonth = "June"
Case "7"
strMonth = "July"
Case "8"
strMonth = "August"
Case "9"
strMonth = "September"
Case "10"
strMonth = "October"
Case "11"
strMonth = "November"
Case "12"
strMonth = "December"
End Select
strDate = strWkday + ", " + strDay +strSuffix + " "
+ strMonth + " " + strYear
strTime = strHour + " " + strMinute + " "
+strMeridian
'---------------------------------------------------
Remove unwanted characters from the txtBody
Dim strShow As String
Stop
For intCounter = 0 To 31
strShow = Cstr (Chr(intCounter))
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(intCounter)), "" )
Next
'---------------------------------------------------
Must break up txtBody into digestible line-based
chunks to feed to Ani.Speak
txtBodyTmp = txtBody
intLen = Len ( txtBodyTmp )
Redim arrLinez (0) As String
If ( Not txtBodyTmp = "" ) And ( atContains
( Cstr ( txtBodyTmp), "." ) = False ) Then
arrLinez (0) = txtBodytmp
Else
Do
intMark = Instr ( txtBodyTmp, "." )
If Left ( txtBodytmp, 35 ) = "----------------------
Forwarded by" Then
intLinez = Ubound ( arrLinez ) + 1
Redim Preserve arrLinez ( intLinez )
arrLinez ( intLinez ) = "Pau=5\Spd=175"+
"This email contains forwarded emails which will not be read aloud."
Exit Do
End If
If intMark = 0 And txtBodyTmp <> "" Then
intLinez = Ubound ( arrLinez ) + 1
Redim Preserve arrLinez ( intLinez )
arrLinez ( intLinez ) = txtBodyTmp
txtBodyTmp = ""
Exit Do
End If
strLine = strLine + Left ( txtBodyTmp, intMark+1 )
txtBodyTmp = Trim ( Mid ( txtBodytmp, intMark+1 ) )
If arrLinez (0) = "" Then
arrLinez (0) = strLine
Else
intLinez = Ubound ( arrLinez ) + 1
Redim Preserve arrLinez ( intLinez )
arrLinez ( intLinez ) = strLine
End If
strLine = ""
Loop Until (txtBodyTmp ) = ""
End If
'---------------------------------------------------
Its Showtime
Call varApp.Characters.Load ( "Merlin",
"C:\WINNT\msagent\chars\merlin.acs" )
Set Merlin = varApp.Characters("Merlin")
Merlin.LanguageID = &H0409
Merlin.Balloon.Style = 0
Merlin.MoveTo -100,-100, 700
Merlin.Show True
'---------------------------------------------------
'Verbalize Preface-n-Header data
Merlin.Speak "Spd=150\Pit=100" +
"Audible reading of email starts now."
Merlin.Speak "Spd=175\Pit=100" +
"Email received from " + "Spd=150" +txtFrom
Merlin.Speak "Spd=175\Pit=100" +
"Sent to you on " + "Spd=150" + strDate +" at " +strTime
If txtSubj <> "" Then Merlin.Speak
"Spd=175\Pit=100" +"Bearing a subject line that reads "
+"Pau=5\Spd=150" + txtSubj
Merlin.Speak "Spd=175\Pit=100" + "Here is the email body."
+ "Pau=5"
'--------------------------------------------------- Verbalize Body content
Forall xLines In arrLinez
Merlin.Speak "Spd=175\Pit=100" + xLines
End Forall
'--------------------------------------------------- Verbalize Ending
If (varAtt (0) -3 ) > 0 Then
If (varAtt (0) -3 ) = 1 Then
Merlin.Speak "Spd=175\Pit=100\Pau=5" +
"This email contains one attachment."
Else
Merlin.Speak "Spd=175\Pit=100\Pau=5" +
"This email contains a total of " + Cstr (varAtt(0) -3) +
" detected attachments."
End If
End If
Merlin.Speak "Spd=175\Pau=20\Pit=100" +
"This email reading now ends."
Set Merlin=Nothing
Exit Sub
'---------------------------------------------------
Error Handler to close varApp/Merlin
errHandler:
Messagebox "Error" & Str(Err) & ": " & Error$
If Not varApp Is Nothing Then
Set Merlin=Nothing
End If
Exit Sub
End Sub
Do you have comments on this tip? Let us know.
This tip was submitted to the SearchDomino.com tip exchange by member Brian Downs. Please let others know how useful it is via the rating scale below. Do you have a useful Notes/Domino tip or code to share? Submit it to our bimonthly tip contest and you could win a prize and a spot in our Hall of Fame.
This was first published in September 2005