Verbalizer: Updated code using MSAgent to read e-mail aloud

In this tip, a reader revises previously submitted code that uses a MS agent to read and string of text fed to it.

This Content Component encountered an error

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

Dig deeper on LotusScript

0 comments

Oldest 

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:

-ADS BY GOOGLE

SearchWindowsServer

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchEnterpriseLinux

SearchDataCenter

SearchExchange

SearchContentManagement

Close