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) &
"attachments\"

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 )
Else
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 )
Else
Msgbox "Unable to complete request, file already
exists."
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

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

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

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

End Sub

This was first published in November 2000
This Content Component encountered an error

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