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.
Code
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:
- 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.
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.
