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


MEMBER FEEDBACK TO THIS TIP

When implementing this tip, I found that the code presented contains two minor bugs:

  1. No path separator for the W32 platform was supplied
  2. 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.
I made corrections to lines 57-59 and 68 of the Initialize event and line 12 of the SetPlatform function. Please find the corrected code below:
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 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
-- Arjan S.


Do you have comments of your own? Let us know.

This was first published in October 2002

Dig deeper on Lotus Notes Domino Administration Tools

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchWindowsServer

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchEnterpriseLinux

SearchDataCenter

SearchExchange

SearchContentManagement

Close