Detach Mail Attachments To Hard Drive

This code can be useful to administrators, but I have designed it for end
users. Place this on an action button in the users inbox, and it will easily
allow the user to detach the mail attachment(s) to a directory below the mail
file. For instance if the mail file ("d:\notes\data\mail\juser.nsf") contains
an attachment named filename.txt, then the attachment will be detached to
"d:\notes\data\mail\attachments\filename.txt" The code will also stamp the
email with a location of the attachment. Minimal modifications will allow you
to place this code in multiple areas.

This will help you with your users with 1 GIG mail files, by making it easy and
consistent to detach the files.
Sub Click(Source As Button)
Dim session As New NotesSession
Dim doc As NotesDocument
Dim rtitem As Variant
Dim filename As String
Dim filepath As String
Dim fnlen As Integer
Dim fplen As Integer
Dim error53 As Variant
Dim error4005 As Variant
Dim attr As Integer

Const ErrFileNotFound = 53
Const ErrCannotCreateFile = 4005

On Error Goto ErrHandle
On Error ErrFileNotFound Goto ErrHandle53
On Error ErrCannotCreateFile Goto ErrHandle4005

fnlen = Len( session.CurrentDatabase.FileName )
fplen = Len( session.CurrentDatabase.FilePath )
filepath = Mid$( session.CurrentDatabase.FilePath, 1, fplen - fnlen) &

Set doc = session.DocumentContext

If doc Is Nothing Then Exit Sub

Set rtitem = doc.GetFirstItem( "Body" )

If ( rtitem.Type = RICHTEXT ) Then
Forall o In rtitem.EmbeddedObjects

If ( o.Type = EMBED_ATTACHMENT ) Then
filename = o.Source
error53 = False
error4005 = False
attr = Getattr ( filepath & filename ) 'Will error to
53 if file does not exist
If error53 Then
Call o.ExtractFile( filepath & filename )
error53 = False
filename = Inputbox$ ( "Please enter a new file name,
" & filename & " already exists.", "File Already Exists", "new" & filename )
If filename = "" Then Exit Sub
attr = Getattr ( filepath & filename ) 'Will error
to 53 if file does not exist

If error53 Then
Call o.ExtractFile( filepath & filename )
Msgbox "Unable to complete request, file already
Exit Sub
End If
End If

If error4005 Then Call o.ExtractFile( filepath & filename )

Call rtitem.AddNewLine( 1 )
Call rtitem.AppendText("[file: " & filename & " detached
to: " & filepath & filename & "]")

Call o.Remove
Call doc.Save( False, True )

End If
End Forall
End If
Exit Sub

' This is file not found, good error, meaning this filename does not already
error53 = True
Resume Next

' directory does not exist so we will create it...
If error4005 Then
'second time through - fatal error - can't really imagine this
Msgbox "Unable to complete request, directory does not exist."
Exit Sub
'first time through - make the directory if possible
Mkdir filepath
error4005 = True
End If
Resume Next

Messagebox "Error" & Str(Err) & ": " & Error$
Exit Sub

End Sub

Dig Deeper on Domino Resources - Part 3

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.




  • iSeries tutorials'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 ...