Remove attachments from multiple mail messages
This tip describes how to remove attachments from multiple mail messages.
View member feedback to this tip.
This script allows you to remove the attachments from a selection of documents. For each attachment you get the option to select the location and file name of the attachment. It will default to the location of the last attachment saved and with the same file name as the attachment. If you manually type in the path or file name it will check to see that the path exists and that there are no duplicate file names.
Place this script in an agent set to run from the Agent List on selected documents. This agent can then be called from an Action button in a view to remove all attachments from the selected documents.
Option Public Dim session As NotesSession Dim path As String Dim separator As String Sub Initialize Dim Workspace As New NotesUIWorkspace Dim db As NotesDatabase Dim collection As NotesDocumentCollection Dim doc As NotesDocument Dim rtitem As Variant Dim filename As String Dim strSaveName As String Dim strSavePath As String Dim dname As String Dim pname As String Dim num As Integer Dim subname As String Dim subext As String Dim position As String Dim subposition As String Dim dec As String Dim message$ Set session = New notesSession Dim richstyle As NotesRichTextStyle Set richstyle = session.CreateRichTextStyle richstyle.NotesColor = COLOR_BLUE Set db = session.CurrentDatabase Set collection = db.UnprocessedDocuments Lastpath = Session.GetEnvironmentString( "FileDlgDirectory" , True ) Set doc = collection.GetFirstDocument Call SetPlatform While Not( doc Is Nothing ) If doc.HasEmbedded Then Set rtitem = doc.getfirstitem("Body") If (rtitem.type = RICHTEXT) Then Forall object In rtitem.EmbeddedObjects If (object.Type = EMBED_ATTACHMENT) Then filename = object.source Do 'Get the file name and path. 'Loop until there is either a valid name or the user cancels from the filesave dialog filepath = Workspace.SaveFileDialog( False , "Save attachment." ,"" , Lastpath , filename ) If Not(Isempty(filepath)) Then flag = checkpath( filepath(0) ) Select Case flag Case 0 'All OK to save File Case 1 'Path was not created Call Workspace.Prompt( PROMPT_OK, "Error", "Path was not created!" ) Case 2 'Duplicate file found flag2 = Workspace.Prompt( PROMPT_YESNO, "Alert", "Replace existing file?" ) If Flag2 = 1 Then Flag = 0 End Select Else flag = 2 End If Loop Until Flag < 2 Or Isempty(filepath) If flag = 0 Then 'If The path and file name are OK then save the file and remove it. Call object.extractfile(filepath(0)) Call object.remove Call rtitem.AddNewLine( 2 ) Call rtitem.AppendStyle(richstyle) Call rtitem.AppendText( "An attachment has been Removed from this document and Saved to --> " & filepath(0) ) Call doc.Save( False, True , True ) 'Reset the environment variable to the last locatation a file was saved. LastPath = Path Call Session.SetEnvironmentVar( "FileDlgDirectory", LastPath , True ) End If End If End Forall End If End If Set doc = collection.GetNextDocument( doc ) Wend End Sub Function checkpath( filepath As String ) 'Check to see if the Directory and file name exist 'If the directory does not exist do you want to create it. strStart = 1 strFound = 1 path = "" filename = "" CreatePath = False checkpath = 0 While strFound > 0 'Look for the path delimiter strFound = Instr(strStart , filepath , separator ) If strFound > 0 Then path = Left( FilePath , strFound ) DoesPathExist = Dir$( path , 16 ) If DoesPathExist = "" Then If CreatePath = False Then YesNo = Messagebox( "Create Path ? " , 4 , "Path does not exist !") End If If YesNo = 6 Then Mkdir path CreatePath = True Else CheckPath = 1 End If End If strStart = strFound + 1 End If Wend If strFound >= 0 Then filename = Mid$( filepath , strStart ) 'Check to see if the file name exists DoesFileExist = Dir$( filepath , 0 ) If DoesFileExist <> "" Then CheckPath = 2 Else Checkpath = 1 End If End Function Sub SetPlatform 'Set the directory separator based on platform 'Only Mac and Win32 formats are supported path = session.GetEnvironmentValue( "FileDlgDirectory" , True ) If path = "" Then path = session.GetEnvironmentValue( "Directory" , True ) End If separator = "" If session.platform = "Macintosh" Then strFound = -1 separator = ":" End If End Sub
When implementing this tip, I found that the code presented contains two minor bugs:
- No path separator for the W32 platform was supplied
- Upon clicking "No" when prompted to replace an existing file, the code did not move on to the next attachment but rather returned to the attachment being processed.
Option Public Dim session As NotesSession Dim path As String Dim separator As String Sub Initialize Dim Workspace As New NotesUIWorkspace Dim db As NotesDatabase Dim collection As NotesDocumentCollection Dim doc As NotesDocument Dim rtitem As Variant Dim filename As String Dim strSaveName As String Dim strSavePath As String Dim dname As String Dim pname As String Dim num As Integer Dim subname As String Dim subext As String Dim position As String Dim subposition As String Dim dec As String Dim message$ Set session = New notesSession Dim richstyle As NotesRichTextStyle Set richstyle = session.CreateRichTextStyle richstyle.NotesColor = COLOR_BLUE Set db = session.CurrentDatabase Set collection = db.UnprocessedDocuments Lastpath = Session.GetEnvironmentString( "FileDlgDirectory" , True ) Set doc = collection.GetFirstDocument Call SetPlatform While Not( doc Is Nothing ) If doc.HasEmbedded Then Set rtitem = doc.getfirstitem("Body") If (rtitem.type = RICHTEXT) Then Forall object In rtitem.EmbeddedObjects If (object.Type = EMBED_ATTACHMENT) Then filename = object.source Do 'Get the file name and path. 'Loop until there is either a valid name or the user cancels from the filesave dialog filepath = Workspace.SaveFileDialog( False , "Save attachment." ,"" , Lastpath , filename ) If Not(Isempty(filepath)) Then flag = checkpath( filepath(0) ) Select Case flag Case 0 'All OK to save File Case 1 'Path was not created Call-- Arjan S.
Workspace.Prompt( PROMPT_OK, "Error", "Path was not created!" ) Case 2 'Duplicate file found flag2 =
Workspace.Prompt( PROMPT_YESNO, "Alert", "Replace existing file?" ) If Flag2 = 1 Then Flag = 0 Else 'addition
08/27/2003 to prevent infinite loop with same attachment Flag = 1 End If End Select Else flag = 2 End If Loop Until Flag < 2 Or Isempty(filepath) If flag = 0 Then 'If The path and file name are OK then save the file and remove it. Call object.extractfile(filepath(0)) End If 'change 08/27/2003 moved up end if
to this point to allow object removal for attachments related to existing files user
chose to NOT replace Call object.remove Call rtitem.AddNewLine( 2 ) Call rtitem.AppendStyle(richstyle) Call rtitem.AppendText( "An attachment has
been Removed from this document and Saved to --> " & filepath(0) ) Call doc.Save( False, True , True ) 'Reset the environment variable to the last locatation a file was saved. LastPath = Path Call Session.SetEnvironmentVar(
"FileDlgDirectory", LastPath , True ) End If End Forall End If End If Set doc = collection.GetNextDocument( doc ) Wend End Sub Function checkpath( filepath As String ) 'Check to see if the Directory and file name exist 'If the directory does not exist do you want to create it. strStart = 1 strFound = 1 path = "" filename = "" CreatePath = False checkpath = 0 While strFound > 0 'Look for the path delimiter strFound = Instr(strStart , filepath , separator ) If strFound > 0 Then path = Left( FilePath , strFound ) DoesPathExist = Dir$( path , 16 ) If DoesPathExist = "" Then If CreatePath = False Then YesNo = Messagebox( "Create Path ? " , 4 , "Path
does not exist !") End If If YesNo = 6 Then Mkdir path CreatePath = True Else CheckPath = 1 End If End If strStart = strFound + 1 End If Wend If strFound >= 0 Then filename = Mid$( filepath , strStart ) 'Check to see if the file name exists DoesFileExist = Dir$( filepath , 0 ) If DoesFileExist <> "" Then CheckPath = 2 Else Checkpath = 1 End If End Function Sub SetPlatform 'Set the directory separator based on platform 'Only Mac and Win32 formats are supported path = session.GetEnvironmentValue( "FileDlgDirectory" , True ) If path = "" Then path = session.GetEnvironmentValue( "Directory" , True ) End If separator = "" If session.platform = "Macintosh" Then strFound = -1 separator = ":" Else 'addition 08/27/2003 to support W32 platform separator = "\" End If End Sub
Do you have comments of your own? Let us know.