|
|
How do you add Quoted Reply support to Notes' mail templates?
Quoted replies let you precede each line of the mail you are replying to with a ">"; it is a standard way of indicating what you are replying to when replying to Internet mail (similiar to how people use color to indicate their replies in Notes). Here is a button you can add to the forms of the standard mail templates. Add an Action Button called "Quoted Reply" to the following forms: Memo, Reply, Reply with History. This button is hidden when: Previewed for reading, Previewed for editing, Opened for editing. The limitation is that it can only quote up to around 15K worth of text because of LotusScript's limitation with GetFormattedText.
Put the following script in the Click action:
Sub Click(Source As Button)
Dim uiws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim uidocReply As NotesUIDocument
Dim rtitemBody As Variant
Dim sBodyOriginal$
Dim sBodyConverted$
Dim vntMailDbFile,vntMailDbServer
Set uidoc=uiws.CurrentDocument
Set doc = uidoc.Document
Set rtitemBody=doc.GetFirstItem("Body")
sBodyOriginal=rtitemBody.GetFormattedText(False,0)
vntMailDbServer=Evaluate("@Subset(@MailDbName;1)")
vntMailDbFile=Evaluate("@Subset(@MailDbName;-1)")
Set uidocReply=uiws.ComposeDocument(Cstr(vntMailDbServer(0)),Cstr(vntMailDbFile(0)), "Reply")
sBodyConverted=ManipulateReplyText(uidoc, sBodyOriginal)
Call uidocReply.FieldSetText("Body", sBodyConverted)
End Sub
Function ManipulateReplyText (Source As NotesUIDocument, body As String)
'Adding > to the begining of each line of the "History text" and
'Aligning the text Left (wrapping)
Print "Formatting ""History"" text"
Dim bd As Variant
Dim note As NotesDocument
Dim Header As NotesItem
Dim dateItem As NotesItem
Dim InFrom As NotesName
Dim GetInternetFullName$, HeaderString$, pos%, tmpString$, pos1%, dont%,tmp$
Dim y%, x%, b%, xx%, xb
Set note=Source.Document
'dividing the text to lines and addding the > sign
If note.hasitem("$AdditionalHeaders") Then
'starting here: inbound messages seem to have $AdditionalHeaders
Set Header=note.GetFirstItem("$AdditionalHeaders")
If Header.values(0) = "" Then
'GetInternetFullName=note.InheritedFrom(0)
GetInternetFullName=note.From(0)
Goto Continue
End If
Else
If Not note.HasItem("tmpAdditionalHeaders") Or
note.tmpAdditionalHeaders(0)="" Then
'GetInternetFullName=note.InheritedFrom(0)
GetInternetFullName=note.From(0)
Goto continue
End If
Set Header=note.Getfirstitem("tmpAdditionalHeaders")
End If
HeaderString=Header.values(0)
pos=Instr(HeaderString,"From: ")
tmpString=Mid(HeaderString,pos+6)
pos1=Instr(tmpString,"<")
If pos1=0 Then 'The full name will appear in (...)
pos1=Instr(tmpString,"(")
tmpString=Mid(tmpString,pos1+1)
pos1=Instr(tmpString,")")
GetInternetFullName=Mid(tmpString,1,pos1-1)
dont=True
Goto Continue
End If
tmpString = Mid(tmpString,1,pos1-1)
pos=Instr(tmpString,|"|)
If pos<>0 Then
tmpString=Mid(tmpString,pos+1)
pos=Instr(tmpString,|"|)
GetInternetFullName=Mid(tmpString,1,pos-1)
Else
GetInternetFullName=tmpString
End If
Continue:
Set InFrom=New NotesName(GetInternetFullName)
' and starting here: I found that inbound messages had a PostedDate item, Not tmpSentOn
If note.HasItem("tmpSentOn") Then
postDate = note.tmpSentOn(0)
Else
Set dateItem = note.GetFirstItem("PostedDate")
postDate = dateItem.Text
End If
tmp="On " & postDate & note.tmpSentOn(0) & " " & InFrom.Common & "
wrote:" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & ">"
y=1
b=1
For x=1 To Len(body)
xx=Asc(Mid(body,x,1))
If x<>Len(body) Then xb=Asc(Mid(body,x+1,1))
'Now that we know the current and the next characters we can consider whether they will cause a line feed, so we can insert our ">".
If xx=10 Or xx=13 Or xx=11 Or xx=12 Then
'if this combination occurs then we skip the next one so we don't LF twice.
If xx=10 And xb=13 Or xx=13 And xb=10 Then
x=x+1
tmp=tmp & Chr (xx) & Chr (xb) & ">"
Else
tmp=tmp & Chr(xx) & ">"
End If
b=1
Else
tmp=tmp & Mid(body,x,1)
b=b+1
End If
Next
ManipulateReplyText=tmp
End Function