'CratchitEmailLibrary: 

Option Public
Use "CratchitCommonLibrary"
'CratchitEmailLibrary: 





Sub Initialize
	' 2004-11-20: DFL : added to support change to CratchitCommonLibrary
	Dim session As NotesSession
End Sub
Sub Terminate
	
End Sub
Sub sEmailReply(ReplyToAll As Boolean, WithHistory As Boolean)
	' Copyright 2003 by David F. Leigh
	' Programmer: Dave Leigh
	' Created: 2003-01-25
	' Changes 
	'	$20040914DFL - Multiple changes
	'		Added Notes style (sectional) replies
	'		Added header to Internet style replies
	'	$20060404DFL - Moved the signature to the top for Notes-style replies
	'	$20071112DFL - Fixed issue where replies look like they originated with the sender.
	'	$20080815DFL - Fixed issue with ReplyToAll
	Dim workspace As New NotesUIWorkspace
	Dim db As NotesDatabase
	Dim curruidoc As NotesUIDocument
	Dim currdoc As NotesDocument
	Dim replydoc As NotesDocument
	Dim uidocNew As NotesUIDocument
	Dim item As NotesItem	
	Dim SendToItem As NotesItem ' 20080815DFL
	Dim NewSendItem As NotesItem ' 20080815DFL
	Dim NewEnterItem As NotesItem ' 20080815DFL
	Dim rtitem As NotesRichTextItem
	Dim rtnav As NotesRichTextNavigator
	Dim beginningText As Variant, endText As Variant
	Dim beforeText As Variant, afterText As Variant
	Dim org_rtitem As NotesRichTextItem
	Dim rtstyle As NotesRichTextStyle
	Dim rtcolor As NotesColorObject
	Dim i As Integer ' 20080815DFL  (used for moving email addresses)
	
	Dim cText As String
	Dim nContinue As Boolean
	Dim aNewText() As String
	Dim InternetStyle As Boolean
	Dim cSectionText As String
	Dim cReplyStyle As String
	Dim cReplyTo As String
	Dim cSignature As String ' 20060404DFL
	Dim cTemp As String ' DFL 20080815
	
	On Error Goto ErrorHandler
	
	' 2004-11-20: DFL : added to support change to CratchitCommonLibrary
	'	It's up here instead of down in the bottom because we don't want to 
	'	pause for input halfway through the process.
	' cName defined in Initialize()
	If WithHistory Then ' the style is moot if there's no history
		InternetStyle = False ' default to Notes style replies
		cReplyStyle = fGetCratchitProfileValue(session.CommonUserName,"ReplyStyle")
		Select Case cReplyStyle
		Case "Internet"
			InternetStyle = True
		Case "Ask"
			If Not PromptYesNo("Compose Notes style Reply?"+Chr(10)+Chr(13)+"'No' will compose an Internet style reply.") Then
				InternetStyle = True
			End If
		End Select
	End If
	
 	' 2006-04-04: DFL: added a replyto address from the profile	
	cReplyTo = Trim(fGetCratchitProfileValue(session.CommonUserName,"ReplyTo"))
	
	' Get Environment Variables
	ServerName=Environ$("CratchitCRMServer")
	dbName=Environ$("CratchitRolodexName")
	
	' Get your Handles
	Set db = workspace.CurrentDatabase.Database
	Set curruidoc = workspace.CurrentDocument
	Set currdoc = curruidoc.Document
	Set replydoc = currdoc.CreateReplyMessage(True)
	
	' Oddly, it doesn't work unless we open and save first. 
	' So this is a kludge to do just that.
	curruidoc.EditMode = True
	curruidoc.Save
	curruidoc.EditMode = False
	
	' 20040923DFL Remove the body, because it contains gobs of stuff we don't want.
	Call replydoc.RemoveItem("body") 
	' We're going to copy everything, then overwrite what we want.
	Call currdoc.CopyAllItems(replydoc,True)
	Call replydoc.ReplaceItemValue("Form", "Reply")
	Call replydoc.ReplaceItemValue("Inbound", False)
	
	cText = replydoc.Subject(0)
	If Ucase$(Left$(cText, 3)) <> "RE:" Then
		Call replydoc.ReplaceItemValue("Subject", "Re: "+ cText)
	End If
	
	' recipient & sender
	' If there's more than one person in the EnterSendTo, then we're going to
	' have to append from to it.
	Set item = replydoc.GetFirstItem( "From" )
	Call replydoc.CopyItem( item, "SendTo" )
	Call replydoc.CopyItem( item, "EnterSendTo" )
	Call replydoc.ReplaceItemValue("From", session.UserName )
	Call replydoc.ReplaceItemValue("Principal", session.UserName) ' $20071112DFL
	Call replydoc.ReplaceItemValue("DisplayFrom", session.CommonUserName )
	Call replydoc.ReplaceItemValue("PostedDate", Now )' $20040917DFL
	Call replydoc.ReplaceItemValue("ReplyTo",cReplyTo) '$20060404DFL
	
	If ReplyToAll Then ' 20080815DFL
		' We ARE replying to all.
		' We'll get other items from the the currdoc's EnterSendTo field if we need them
		Set SendToItem = currdoc.GetFirstItem("SendTo")
		Set NewSendItem = replydoc.GetFirstItem("SendTo")
		Set NewEnterItem = replydoc.GetFirstItem("EnterSendTo")
		For i = 0 To Ubound(SendToItem.Values)
			cTemp = SendToItem.Values(i)
			Call NewSendItem.AppendToTextList(cTemp)
			Call NewEnterItem.AppendToTextList(cTemp)
		Next
	Else
		Call replydoc.ReplaceItemValue("CopyTo", "" )
		Call replydoc.ReplaceItemValue("EnterCopyTo", "" )
	End If
	
	' UniqueID
	cText = fCreateUniqueID
	Call replydoc.ReplaceItemValue("UniqueID_1", cText)
	cSignature = fGetSignature ' 20060404DFL
	
	' the body is complicated.
	If WithHistory Then			
		If InternetStyle Then
			' Internet style history
			' Use the following style of delimiter:
			'  "InformIT Linux" <linux_news@informit.com> wrote on 09/07/2004 03:05:30 AM:
			cReplyTo = currdoc.ReplyTo(0)
			If cReplyTo = "" Then
				cReplyTo = currdoc.ClientContact(0)
				If cReplyTo = "" Then
					cReplyTo = "You"
				End If
			End If
			cReplyTime = currdoc.PostedDate(0)
			cReplyTime = Cstr(cReplyTime) ' 20051005DFL to remove bug in next line
			cSectionText = cReplyTo + " wrote on " + cReplyTime + ":" 
			
			Set rtitem = replydoc.GetFirstItem("body")
			cText = rtitem.Text
			cText = Left$(cText, rtitem.valuelength)
			aText = Split(cText, Chr(13)+Chr(10))
			nContinue = True
			For nLoopItem=0 To Ubound(aText)
				' 20040923DFL Removed conditional code that was necessary before I removed the body, above.
				Redim Preserve aNewText(nLoopItem+1)
				aNewText(nLoopItem)= "> " + aText(nLoopItem)
			Next
			cText = Join(aNewText, Chr(13)+Chr(10))
			cText = cSectionText + Chr(10)+Chr(13)+cText
			
			Call replydoc.ReplaceItemValue("Body", cText )
			Call session.SetEnvironmentVar("CratchitSuppressSig", "") ' 20060404DFL
		Else
			' Notes Style Replies
			' Contributed by Rob Breault/NC/Apisci
			' Added 2004/11/11
			' Many thanks for this patch!
			Call replydoc.RemoveItem("Body")
			
			Set org_rtitem = currdoc.GetFirstItem("Body")
			Set rtitem = New NotesRichTextItem(replydoc,"Body")
			
			Call rtitem.AppendText(cSignature) ' 20060404DFL
			
			Set rtstyle = session.CreateRichTextStyle
			rtstyle.Bold = True
			Set rtcolor = session.CreateColorObject
			rtcolor.NotesColor = COLOR_DARK_BLUE
			
			Call rtitem.AddNewline(1)
			Call rtitem.BeginSection("---- Original Message ----", rtstyle, rtcolor, True)
			' This gives us a basic reply header....
			' Yes, I know that the first line is redundant, 
			' but non-Notes recipients don't see a collapsible section, so it's necessary.
			Call rtitem.AppendText("=== Original Message ===" )
			Call rtitem.AddNewline(1)
			Call rtitem.AppendText(|From: "| & currdoc.ClientContact(0) & |" <| & currdoc.From(0) & |>| )
			Call rtitem.AddNewline(1)
			Call rtitem.AppendText(|Sent: | & Cstr(currdoc.PostedDate(0)) )
			Call rtitem.AddNewline(1)
			Call rtitem.AppendText(|To: | & Join(currdoc.SendTo,", ") )
			Call rtitem.AddNewline(1)
			If currdoc.CopyTo(0) <> "" Then
				Call rtitem.AppendText(|Cc: | & Join(currdoc.CopyTo,", ") )
				Call rtitem.AddNewline(1)
			End If
			Call rtitem.AppendText(|Subject: | & currdoc.Subject(0) )
			
			Call rtitem.AddNewline(2)
			Call rtitem.AppendRTItem(org_rtitem)
			Call rtitem.EndSection
			Call rtitem.Update
			Call session.SetEnvironmentVar("CratchitSuppressSig", "Yes") ' 20060404DFL
		End If
	Else
		cText = ""
		Call replydoc.ReplaceItemValue("Body", cText )
	End If
	
	' Create the new document
	Set uidocNew = workspace.EditDocument(True, replydoc, False)
	
ExitSub:
	Exit Sub
ErrorHandler:
	Call HandleError("CratchitEmailLibrary->sEmailReply","",True)
	Resume ExitSub
End Sub
Sub sInsertSignature (Source As NotesUIDocument)
'	Changes
'	20060404DFL changed to suppress signatures.
' 	20080815DFL fixed signature insert if not replying with history
	
	Dim session As New NotesSession
	Dim ws As New NotesUIWorkspace
	Dim cSignature As String
	Dim rtSignature As NotesRichTextItem
	Dim cAutoSig As String
	Dim cSuppressSig As String ' 20060404DFL 
	Dim cSignatureType As String ' 20061118DFL
	Dim rtbody As NotesRichTextItem
	Dim profiledoc As NotesDocument
	Dim doc As NotesDocument
	Dim cFieldname As String
	Dim uidocNew As NotesUIDocument
	Dim rtnav As NotesRichTextNavigator
	
	On Error Goto ErrorHandler
	
	cAutosig = fGetCratchitProfileValue(session.CommonUserName,"AutoSig")
	cSuppressSig = session.getEnvironmentString("CratchitSuppressSig")
	cSignatureType = fGetCratchitProfileValue(session.CommonUserName,"SignatureType")
	cFieldname = Source.CurrentField ' remember the current field if any
	
	If Source.Document.HasSignature(0) = "Yes" Then
		Exit Sub
	End If
	
	If (cAutoSig = "Yes") And (cSuppressSig<>"Yes") Then
		If cSignatureType <> "RichText" Then
			cSignature = fGetSignature
			Call Source.FieldAppendText("Body", cSignature)
		Else
			'Get the signature from the profile document 
			Set profiledoc = fGetCratchitProfile(session.CommonUserName)
			Set rtSignature = profiledoc.GetFirstItem("RTSignature")
			
			If Not rtSignature Is Nothing Then
				Set doc = Source.Document ' get a handle
				
'				Set rtbody = doc.GetFirstItem("body") ' 20080815DFL 
				
				If True Then '  rtbody Is Nothing Then
					' just replace the whole thing
					doc.RemoveItem("body")
					doc.CreateRichTextItem("body")
					Set rtbody = doc.GetFirstItem("body")
					Call rtbody.AppendRTItem(rtSignature)
				Else
					' prepend the text with the sig. We'll need a navigator and we'll append the text at the beginning
					Set rtnav = rtbody.CreateNavigator
					Call rtnav.FindFirstElement(RTELEM_TYPE_TEXTPARAGRAPH)
					Call rtbody.BeginInsert(rtnav)
					Call rtbody.AppendRTItem(rtSignature)
				End If
				
				' We don't want to loop through this nonsense again
				Call doc.ReplaceItemValue("HasSignature", "Yes")
				
				Call doc.Save(True, False, True) ' Save the changes to the rich text fields
				Call doc.ReplaceItemValue("SaveOptions", "0") ' Prevent the UI "do you wan to save" prompt
				Call Source.Reload ' Bring that save options field into the front end
				Call Source.Close(True)
				Set uidocNew = ws.EditDocument(True, doc, , , , True)
			End If
		End If
	End If
	
	Call session.SetEnvironmentVar("CratchitSuppressSig", "")
	
ExitSub:
	Exit Sub
ErrorHandler:
	Call HandleError("CratchitEmailLibrary->sInsertSignature","",True)
	Resume ExitSub
	
End Sub
Sub sEmailForward
	' Copyright 2003 by David F. Leigh
	' Programmer: Dave Leigh
	' Created: 2003-01-25
	' Changes 
	'	$20040914DFL - Multiple changes
	'		Added Notes style (sectional) replies
	'		Added header to Internet style replies
	'	$20060404DFL - Moved the signature to the top for Notes-style replies
	'	$20071112DFL - Fixed issue where replies look like they originated with the sender.
	'	$20080815DFL - Completely revised using latest sEmailReply as a guide
	Dim workspace As New NotesUIWorkspace
	Dim db As NotesDatabase
	Dim curruidoc As NotesUIDocument
	Dim currdoc As NotesDocument
	Dim replydoc As NotesDocument
	Dim uidocNew As NotesUIDocument
	Dim item As NotesItem	
	Dim SendToItem As NotesItem ' 20080815DFL
	Dim NewSendItem As NotesItem ' 20080815DFL
	Dim NewEnterItem As NotesItem ' 20080815DFL
	Dim rtitem As NotesRichTextItem
	Dim rtnav As NotesRichTextNavigator
	Dim beginningText As Variant, endText As Variant
	Dim beforeText As Variant, afterText As Variant
	Dim org_rtitem As NotesRichTextItem
	Dim rtstyle As NotesRichTextStyle
	Dim rtcolor As NotesColorObject
	Dim i As Integer ' 20080815DFL  (used for moving email addresses)
	
	Dim cText As String
	Dim nContinue As Boolean
	Dim aNewText() As String
	Dim InternetStyle As Boolean
	Dim cSectionText As String
	Dim cReplyStyle As String
	Dim cReplyTo As String
	Dim cReplyTime As String
	Dim cSignature As String ' 20060404DFL
	Dim cTemp As String ' DFL 20080815
	
	On Error Goto ErrorHandler
	
	' 2004-11-20: DFL : added to support change to CratchitCommonLibrary
	'	It's up here instead of down in the bottom because we don't want to 
	'	pause for input halfway through the process.
	' cName defined in Initialize()
	InternetStyle = False ' default to Notes style replies
	
 	' 2006-04-04: DFL: added a replyto address from the profile	
	cReplyTo = Trim(fGetCratchitProfileValue(session.CommonUserName,"ReplyTo"))
	
	' Get Environment Variables
	ServerName=Environ$("CratchitCRMServer")
	dbName=Environ$("CratchitRolodexName")
	
	' Get your Handles
	Set db = workspace.CurrentDatabase.Database
	Set curruidoc = workspace.CurrentDocument
	Set currdoc = curruidoc.Document
	Set replydoc = currdoc.CreateReplyMessage(True)
	
	' Oddly, it doesn't work unless we open and save first. 
	' So this is a kludge to do just that.
	curruidoc.EditMode = True
	curruidoc.Save
	curruidoc.EditMode = False
	
	' 20040923DFL Remove the body, because it contains gobs of stuff we don't want.
	Call replydoc.RemoveItem("body") 
	' We're going to copy everything, then overwrite what we want.
	Call currdoc.CopyAllItems(replydoc,True)
	Call replydoc.ReplaceItemValue("Form", "Reply")
	Call replydoc.ReplaceItemValue("Inbound", False)
	
	cText = replydoc.Subject(0)
	If Ucase$(Left$(cText, 4)) <> "FWD:" Then
		Call replydoc.ReplaceItemValue("Subject", "Fwd: "+ cText)
	End If
	
	' sender
	Call replydoc.ReplaceItemValue("From", session.UserName )
	Call replydoc.ReplaceItemValue("Principal", session.UserName) ' $20071112DFL
	Call replydoc.ReplaceItemValue("DisplayFrom", session.CommonUserName )
	Call replydoc.ReplaceItemValue("PostedDate", Now )' $20040917DFL
	' OK, this is a forward, so we really don't care what was there.
	' We're just setting all address fields to blank.
	Call replydoc.ReplaceItemValue("CopyTo", "" )
	Call replydoc.ReplaceItemValue("SendTo", "" )
	Call replydoc.ReplaceItemValue("EnterSendTo", "" )
	Call replydoc.ReplaceItemValue("EnterCopyTo", "" )
	Call replydoc.ReplaceItemValue("ReplyTo",cReplyTo) '$20060404DFL
	' And the account fields, too.
	Call replydoc.ReplaceItemValue("ClientContact", "" )
	Call replydoc.ReplaceItemValue("ClientAddress", "" )
	Call replydoc.ReplaceItemValue("ClientPhone", "" )
	Call replydoc.ReplaceItemValue("Client_ID", "" )
	Call replydoc.ReplaceItemValue("OrgName", "" )
	Call replydoc.ReplaceItemValue("OrgDesc", "" )
	Call replydoc.ReplaceItemValue("Account_Type", "" )
	Call replydoc.ReplaceItemValue("Account_Status", "" )
	Call replydoc.ReplaceItemValue("OrgAddress", "" )
	Call replydoc.ReplaceItemValue("OrgPhone", "" )
	Call replydoc.ReplaceItemValue("Org_ID", "" )
	
	' UniqueID
	cText = fCreateUniqueID
	Call replydoc.ReplaceItemValue("UniqueID_1", cText)
	cSignature = fGetSignature ' 20060404DFL
	
	' the body is complicated.
	' Notes Style Replies
	' Contributed by Rob Breault/NC/Apisci
	' Added 2004/11/11
	' Many thanks for this patch!
	Call replydoc.RemoveItem("Body")
	
	Set org_rtitem = currdoc.GetFirstItem("Body")
	Set rtitem = New NotesRichTextItem(replydoc,"Body")
	
	Call rtitem.AppendText(cSignature) ' 20060404DFL
	
	Set rtstyle = session.CreateRichTextStyle
	rtstyle.Bold = True
	Set rtcolor = session.CreateColorObject
	rtcolor.NotesColor = COLOR_DARK_BLUE
	
	Call rtitem.AddNewline(1)
	cReplyTime = Cstr(currdoc.PostedDate(0))
	cSectionText = "==== Forwarded by " + session.CommonUserName + " (" + cReplyTime + ") ====" 
	Call rtitem.BeginSection(cSectionText, rtstyle, rtcolor, True)
			' This gives us a basic reply header....
			' Yes, I know that the first line is redundant, 
			' but non-Notes recipients don't see a collapsible section, so it's necessary.
	Call rtitem.AppendText(cSectionText + Chr(10)+Chr(13)+Chr(10)+Chr(13) )
	Call rtitem.AddNewline(1)
	Call rtitem.AppendText(|From: "| & currdoc.ClientContact(0) & |" <| & currdoc.From(0) & |>| )
	Call rtitem.AddNewline(1)
	Call rtitem.AppendText(|Sent: | & Cstr(currdoc.PostedDate(0)) )
	Call rtitem.AddNewline(1)
	Call rtitem.AppendText(|To: | & Join(currdoc.SendTo,", ") )
	Call rtitem.AddNewline(1)
	If currdoc.CopyTo(0) <> "" Then
		Call rtitem.AppendText(|Cc: | & Join(currdoc.CopyTo,", ") )
		Call rtitem.AddNewline(1)
	End If
	Call rtitem.AppendText(|Subject: | & currdoc.Subject(0) )
	
	Call rtitem.AddNewline(2)
	Call rtitem.AppendRTItem(org_rtitem)
	Call rtitem.EndSection
	Call rtitem.Update
	Call session.SetEnvironmentVar("CratchitSuppressSig", "Yes") ' 20060404DFL
	
	' Create the new document
	Set uidocNew = workspace.EditDocument(True, replydoc, False)
	
ExitSub:
	Exit Sub
ErrorHandler:
	Call HandleError("CratchitEmailLibrary->sEmailForward","",True)
	Resume ExitSub	
End Sub