Tip

Using MSAgent to vocally/audibly read e-mail aloud

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: 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

This was first published in September 2002

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.