Domino Code Fragment

Code Name*
Quoted Reply		Date*
04/28/2024		Source (or email address if you prefer)*
Rlatulippe@romac.com
IP address:.18.225.11.98
Description*
Type*
LotusScript		Categories*
(Misc)
Implementation:
Required Client:
Server:
Limitations:
Comments:
Files/Graphics attachments (if applicable): Code:
Ok, here is the procedure I wrote about the "installation" of this script
(actually it is plug & play)

This button has been added on the following forms :
Memo
Reply
Reply with History

This button is hidden when :
Previewed for reading
Previewed for editing
Opened for editing

An Action Button was added on the above form. The button was called "Quoted
Reply".

The following script was put 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


Now, the following function was copied and pasted right after the above
script.
Notes create a new function entry called "ManipulateReplyText".


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