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

Dig deeper on Domino Resources - Part 3

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