View member feedback to this tip.
There is nothing more annoying than receiving a reply to a message you sent with your original attachment included. It is a complete waste of space and reso>urces and a great nemesis to already taxed e-mail servers and managed mailbox databases. We have come up with separate options for replying to messages with attachments. These options will remove the attachments from a new Reply with History or Reply to All with History and replace the attachment with a message saying the attachment has been removed.
Code
First, create two new Shared actions and copy the code for the actions:
-------------------------------------
"Reply with History - attachments removed":
Shared Action Code:
@If(@IsDocTruncated; @Prompt([OK]; "Reply with History"; "This document is truncated."); "");
@SetEnvironment( "tmpReplyHistAll" ; "FALSE" ) ;
@SetEnvironment("tmpReplyWithoutAttachments"; "1");
@Command([ToolsRunMacro] ; "(ReplyNoAttachments)" )
---------------------------------------
"Reply to All with History - attachments removed"
Shared Action Code:
xxTitle:="Reply with History";
xxMessage:= "This document is truncated.";
@If
(
@Text(@Right(@NoteID; "NT")) != "00000000";
@Do
(
@If
(
@IsDocTruncated;
@Prompt([OK]; xxTitle; xxMessage);
""
);
@Environment("MailStEd";"9")
);
""
);
@SetEnvironment( "tmpReplyHistAll" ; "TRUE" ) ;
@SetEnvironment("tmpReplyWithoutAttachments"; "1");
@Command([ToolsRunMacro] ; "(ReplyNoAttachments)" )
---------------------------------------
Second, create an agent (named "ReplyNoAttachments") which is a shared agent run manually from agent list on selected documents. Here is the code:
'---------
'(Options)
'---------
Option Public
Option Declare
Use "Common"
'------------
'(Initialize)
'------------
Sub Initialize
Dim uiws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim sess As New NotesSession
Dim errormsg(2) As String
On Error Goto errorhandler
' this text is common to all error messages
errormsg(0) = " You can remove the attachment(s) manually prior to sending the reply"_
&" by selecting the attachment icon(s) and pressing delete."
' used when doc contains mixed attachment or object embed
errormsg(1) = "This document contains attachment(s) which cannot be removed by this process." & errormsg(0)
' used for any error
errormsg(2) = "An error occurred while processing this document." & errormsg(0)
Set uidoc = uiws.currentdocument
If uidoc Is Nothing Then ' if activated from view open document in ui
Call uiws.EditDocument(False)
Set uidoc=uiws.currentDocument
End If
Set doc = uidoc.document
If doc.HasEmbedded = False Then ' if no attachments create standard Reply skip remaining process
Call OpenReplyInUI( uiws )
Exit Sub
End If
Dim count As Integer
Dim rtitem As notesrichtextitem
Dim inbody!
Set rtitem=doc.getFirstItem("body") ' get body
count = 0
' determine how attachment is saved in doc
If Typename(rtitem.embeddedObjects) <> "EMPTY" Then
Forall x In rtitem.embeddedObjects
If x.type = EMBED_ATTACHMENT Then
count = 1
inbody! = True
Exit Forall
End If
End Forall
Else
Forall fld In doc.items
If fld.Type = ATTACHMENT Then
count=1
Exit Forall
End If
End Forall
End If
If count = 0 Then ' If type ATTACHMENT not found then create standard reply
Call OpenReplyInUI( uiws )
Exit Sub
End If
Dim continue!, RWAP%, TRWOA%
' Get ini variables so we know what user wants to do
RWAP% = sess.GetEnvironmentValue( "ReplyAttachPrompt", False )
TRWOA% = sess.GetEnvironmentValue( "tmpReplyWithoutAttachments", False )
Select Case True
Case RWAP% = "1" ' user has their preference set to prompt.
continue! = Msgbox( "Would you prefer to reply without attachments? This is recommended to improve performance and disk usage."_
,36, "Remove Attachments" )
Case TRWOA% = "1" ' preference is set not to prompt and user has selected menu option to remove attachments
continue! = 6
Case TRWOA% = "0" ' preference is set not to prompt and user has not selected menu option to remove attachments
continue! = 0
End Select
' clear tmporary ini variable
Call sess.SetEnvironmentVar( "tmpReplyWithoutAttachments", "", False )
'execution
If continue! <> "6" Then
Call OpenReplyInUI( uiws )
Exit Sub
End If
Dim uidoc2 As notesuidocument
Dim replyuidoc As notesuidocument
Dim tempdoc As NotesDocument
Dim namelist() As String
Dim rtitem2 As notesrichtextitem
Dim richStyle As NotesRichTextStyle
Dim db As NotesDatabase
Dim cnt!
Set db = sess.currentDatabase
Set tempdoc = New NotesDocument(db)
If inbody! Then
Forall x In rtitem.embeddedObjects
If x.type = EMBED_ATTACHMENT Then
Redim Preserve namelist( cnt! )
namelist(cnt!) = x.name
x.remove
cnt! = cnt! + 1
Else
Goto cannotremove ' if an embedded object not of type Attachment then exit
End If
End Forall
Else
Forall x In doc.items
If x.type= ATTACHMENT Then
Redim Preserve namelist( cnt! )
namelist(cnt!) = x.values(0)
x.remove
cnt! = cnt! + 1
Else
Goto cannotremove ' if an embedded object not of type Attachment then exit
End If
End Forall
End If
' this section builds a message that lists the names of the removed attachments
Set richStyle = sess.CreateRichTextStyle ' first we define the style
richStyle.NotesFont = FONT_COURIER
richStyle.FontSize = 12
richStyle.NotesColor = 10
Set rtitem2 = New notesrichtextitem( doc, "msgbody" ) ' create a place to store the message
Call rtitem2.AppendStyle(richStyle) ' apply the style
Forall n In namelist
rtitem2.Addnewline( 1 ) ' prepare comment lines
rtitem2.AppendText( "An attachment named " + Ucase( n ) + " was removed." )
End Forall
rtitem2.Addnewline( 2 )
Call rtitem2.Appendrtitem( rtitem ) ' pre-pend attachment message to Body field
rtitem.remove ' remove old rtitem so it can be reused
Set rtitem =rtitem2.copyitemtodocument( doc, "Body" )
rtitem2.remove ' remove rtitem2 'cause it's not needed
Call doc.CopyAllItems(tempdoc,True)
Call tempdoc.MakeResponse( doc)
Call tempdoc.Save(True,False)
Set uidoc2 = uiws.EditDocument(True,tempdoc)
Set replyuidoc = OpenReplyInUI( uiws )
Dim refitem As NotesItem
Set refitem = tempdoc.GetFirstItem("$REF")
Call refitem.CopyItemToDocument( replyuidoc .document,"$REF")
Call uidoc2.close
Call tempdoc.Remove(True)
Exit Sub
errorhandler:
Msgbox "Error " & Err & ". " & errormsg(2), 16, "Operation Failed"
If Not uidoc2 Is Nothing Then
Call uidoc2.close
End If
If Not replyuidoc Is Nothing Then
replyuidoc.close
End If
If Not tempdoc Is Nothing Then
Call tempdoc.Remove(True)
End If
Call OpenReplyInUI( uiws ) ' create standard reply
Exit Sub
cannotremove:
Msgbox errormsg(1), 16, "Unable to complete operation."
Call OpenReplyInUI( uiws ) ' create standard reply
Exit Sub
End Sub
'-------------
'OpenReplyInUI
'-------------
Function OpenReplyInUI( uiws As notesuiworkspace ) As notesuidocument
Dim sess As New notessession
Dim replyuidoc As notesuidocument
On Error Resume Next
Set replyuidoc = uiws.ComposeDocument("","","Reply With History")
' This call is to the Lotus provided Common script libray.
' It is necessary for the cc field to be properly populated.
' The environment var is set by the Reply with History and Reply to All with History action buttons
If sess.Getenvironmentstring( "tmpReplyHistAll", False) = "TRUE" Then
Call MEMOReplyToAll( replyuidoc.document )
replyuidoc.reload
End If
Set OpenReplyInUI = replyuidoc
End Function
MEMBER FEEDBACK TO THIS TIP
Great tip! It is easy to implement and little impact to user behavior. Why didn't we think of this before?
—Stan E.
