After reading & experimenting with "How to create animated, context sensitive help for the Notes client" written by Jim Perry, it occurred to me that by literally sending the Animation off-screen, I could leverage MSAgent to "read-aloud" email content !
What I've done is to create a new Memo form in the email db, called "Vocal Memo". To this I add a button, "Read Mail Now", but the code could easily be moved to the PostOpen event. We're running a ReplaceSubstring to convert the RTBody text, and breaking paragraphs into easily digestible lines for the MSAgent to enunciate via a scripted @Contains. One new field is required, to store the Full Text Date (dtFullTextDate).
We then summon the MSAgent, but prior to revealing it ( "Merlin.Show = True" ) we set the MSAgents' display coordinates to negative off-screen values ( "Merlin.MoveTo -100,-100, 700" ). This enables our MSAgents' "voice" without subjecting users to the MSAgents' animation.
Issues : Please swap your own version of @ReplaceSubstring/@Contains to replace the ones referenced below.
Additionally, while we test for a "-----forwards" string to stop MSAgents' speech from reading a previous email, not all forwarded/replied emails contain this string. I'm still looking for a means of distinguishing the current Body email text from the previous email text. Any advice on accomplishing this is welcome!
Please reference the excellent article above to discover more about how to manipulate MSAgent for Notes!
Thanks SearchDomino ! You're an excellent resource ! - bdowns@dtcc.com
Code
Code: 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 app As Variant
Dim txtBody As String
Dim txtName As NotesName
Dim dtDate As NotesDateTime
Set uidoc = nw.CurrentDocument
Set doc = uidoc.Document
Set rtItem = doc.GetFirstItem ( "Body" )
Set app=uidoc.GetObject("Microsoft Agent Control 2.0")
varAtt = Evaluate ( NotesMacro$, doc )
If Contains ( doc.From (0), "@" ) Then
txtFrom = doc.From (0)
Else
Set txtName = New NotesName ( doc.From (0))
txtFrom = txtName.Common
End If
txtDate = doc.dtFullTextDate (0) ' New Field added to form
txtSubj = doc.Subject (0)
txtBody = Lcase ( Cstr ( rtItem.Text ) )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(0)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(1)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(2)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(3)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(4)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(5)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(6)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(7)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(8)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(9)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(10)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(11)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(12)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(13)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(14)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(15)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(16)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(17)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(18)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(19)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(20)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(21)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(22)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(23)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(24)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(25)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(26)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(27)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(28)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(29)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(30)), "" )
txtBody = ReplaceSubstring ( txtBody, Cstr (Chr(31)), "" )
' 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 ( Contains ( 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
With app
.Characters.Load "Merlin", "c:winntmsagentcharsMerlin.acs"
End With
Set Merlin = app.Characters("Merlin")
Merlin.LanguageID = &H0409
Merlin.Balloon.Style = 0
Merlin.MoveTo -100,-100, 700
Merlin.Show True
Merlin.Speak "Spd=100 Pit=115" + "Audible reading of email starts now."
Merlin.Speak "Ctx=""E-mail"" Spd=175 Pit=115" +"Email received from " + "Spd=100" +txtFrom
Merlin.Speak "Spd=175 Pit=115" +"Sent to you on " + "Spd=100" + txtDate
If txtSubj <> "" Then Merlin.Speak "Spd=175 Pit=115" +"Bearing a subject
line that reads " +"Pau=5 Spd=100" + txtSubj
Merlin.Speak "Spd=175 Pit=115" + "Here is the email body." + "Pau=5"
Forall xLines In arrLinez
Merlin.Speak "Spd=175 Pit=115" + xLines
End Forall
If (varAtt (0) -3 ) > 0 Then
If (varAtt (0) -3 ) = 1 Then
Merlin.Speak "Spd=175 Pit=115 Pau=5" +"This email contains one attachment."
Else
Merlin.Speak "Spd=175 Pit=115 Pau=5" +"This email contains a total of " +
Cstr (varAtt(0) -3) + " detected attachments."
End If
End If
Merlin.Speak "Spd=175 Pau=5 Pit=115 Pau=5" +"This email reading now ends."
Set Merlin=Nothing
errHandler:
If Not app Is Nothing Then
Set Merlin=Nothing
End If
Exit Sub
End Sub
