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 ( = Brian Downs ) 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 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