HiDoes anyone have some sample code that would find a file in a specific folder and automatically attach it to a new mail?
Many thanks.
Coll
Subject: Find a file and link to an email
Here is a function that does what you want. You could also copy the body field, instead of detaching and attaching the file - that would be simpler.
You need to supply the correct parameters for:
folderName - the folder to search for
attachmentName - name of attachment to search for in folder
fieldName - the rich text field where the file is attached in the document
filePath - temporary file path, remember to end with backslash i.e. d:\temp\
varSendTo - variant, people to send to
Function SendAttachment( folderName$, attachmentName$, fieldName$, filePath$, varSendTo As Variant )
Dim s As New notessession
Dim view As NotesView
Dim doc As notesdocument
Dim itemBody As NotesRichTextItem
Dim docMemo As NotesDocument
Dim itemBodyMemo As NotesRichTextItem
On Error Goto errorHandling
Set view = s.currentdatabase.getview( folderName$ )
If view Is Nothing Then Error 2001, "Cant find folder: " & folderName$
Set doc = view.GetFirstDocument
If doc Is Nothing Then Error 2001, "No documents in folder: " & folderName$
While Not (doc Is Nothing)
If doc.HasEmbedded Then
Set itemBody = doc.GetFirstItem( fieldName$ )
Forall obj In itemBody.EmbeddedObjects
If obj.type = EMBED_ATTACHMENT Then
' save the file to disk. You can also copy the whole item to the body of the memo
If obj.name = attachmentName$ Then
Call obj.extractfile( filePath$ & obj.name )
' Create new memo document and set a few fields
Set docMemo = New NotesDocument( s.currentdatabase )
Call docMemo.AppendItemValue( "Form", "Memo" )
Call docMemo.AppendItemValue( "SendTo", varSendTo )
Call docMemo.AppendItemValue( "Subject", attachmentName$ )
' Create a RichText field and attach the file
Set itemBodyMemo = New NotesRichTextItem( docMemo, "Body" )
Call itemBodyMemo.EmbedObject( EMBED_ATTACHMENT, "", filePath$ & attachmentName$ )
' Send the memo
Call docMemo.Send( False )
End If
End If
End Forall
End If
Set doc = view.GetNextDocument( doc )
Wend
SendAttachment = True
Exit Function
errorHandling:
Print "SendAttachment reports:"
Print Cstr(Err) & " " Error$
SendAttachment = False
Exit Function
End Function
Subject: RE: Find a file and link to an email
After posting the code, I saw a potential flaw. Function should check for existance of fieldName$ - and do is better than while, so here it is again, along with an example how to call:
Call SendAttachment( “AllFolder”, “desktop.ini”, “BodyAttachment”, "d:\temp", “Villi Helgason/BigCorp” )
Function SendAttachment( folderName$, attachmentName$, fieldName$, filePath$, varSendTo As Variant )
Dim s As New notessession
Dim view As NotesView
Dim doc As notesdocument
Dim itemBody As NotesRichTextItem
Dim docMemo As NotesDocument
Dim itemBodyMemo As NotesRichTextItem
On Error Goto errorHandling
Set view = s.currentdatabase.getview( folderName$ )
If view Is Nothing Then Error 2001, "Cant find folder: " & folderName$
Set doc = view.GetFirstDocument
If doc Is Nothing Then Error 2001, "No documents in folder: " & folderName$
Do
If doc.HasEmbedded Then
If doc.HasItem( fieldName$ ) Then
Set itemBody = doc.GetFirstItem( fieldName$ )
Forall obj In itemBody.EmbeddedObjects
If obj.type = EMBED_ATTACHMENT Then
' Save the file to disk. You can also copy the whole item to the body of the memo
If obj.name = attachmentName$ Then
Call obj.extractfile( filePath$ & attachmentName$ )
' Create new memo document and set a few fields
Set docMemo = New NotesDocument( s.currentdatabase )
Call docMemo.AppendItemValue( "Form", "Memo" )
Call docMemo.AppendItemValue( "SendTo", varSendTo )
Call docMemo.AppendItemValue( "Subject", attachmentName$ )
' Create a RichText field and attach the file
Set itemBodyMemo = New NotesRichTextItem( docMemo, "Body" )
Call itemBodyMemo.EmbedObject( EMBED_ATTACHMENT, "", filePath$ & attachmentName$ )
' Send the memo
Call docMemo.Send( False )
End If
End If
End Forall
End If
End If
Set doc = view.GetNextDocument( doc )
Loop While Not (doc Is Nothing )
SendAttachment = True
Exit Function
errorHandling:
Print "SendAttachment reports:"
Print Cstr(Err) & " " Error$
SendAttachment = False
Exit Function
End Function
Subject: RE: Find a file and link to an email
Hi…many thanks for your reponses. I will be trying out the code soon and will let you know. I really appreciate!