I have 2 rich text fields where I can add attachments. That works fine. Now I want a button, and when I click it I want to copy all attachments to a new rich text field. I can´t figure it out. Here is my code. In my code I just want to get the attachments from one rich text field:
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim db As NotesDatabase
Dim doc As NotesDocument
Set db=session.CurrentDatabase
Set uidoc = ws.Currentdocument
Set doc=uidoc.Document
' This is the rich text field I want to copy the attachments to
Dim attachInternal As NotesRichTextItem
Set attachInternal = doc.GetFirstItem("InternalMailAttachment")
' This is the rich text field where the attachments are from the begining
Dim desAttachments As NotesRichTextItem
Set desAttachments = doc.GetFirstItem("desAttachments")
Call attachInternal.AppendRTItem( desAttachments )
Call uidoc.Refresh
I´ve tried your code Shane, but I can´t get it work. Even if I manualy save and close the document, the attachment still doesn´t appear in InternalMailAttachments rich text field.
Is there another way to add or copy the attachment. As I wrote in my last response, is it possible to add the same attachement into two rich text fields with this code?
It is a zipped nsf file with an agent that does what you are asking for. The code could just as easily be run from an action.
There are two forms, RTFCopyDemo1 and 2. If you create a doc, put rtf in the top RTF field and run the action it does what you want it to do.
The Action runs an agent which is also runnable from the actions menu. The code in the agent is well commented and very robust as it checks everything in a step by step fashion.
If you have problems downloading it then email me at shane_hollis2001 at yahoo dot com and I’ll forward it to you.
I’ll paste the code below as well.
HTH,
Shane
Sub Initialize
On Error Goto errHandle
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim attachInternal As NotesRichTextItem
Dim desAttachments As NotesRichTextItem
Dim noteID As String
Dim oldSaveoptions As String
Set db=session.CurrentDatabase
Set uidoc = ws.Currentdocument
' At this point I am going to presume there may be
' new attachments in desAttachments put there from the current edit of the uidoc
' This save also means that if this is a new document that we have a copy of the
' document saved in the backend DB so we can get a handle to it
Call uidoc.Save
Set doc=uidoc.Document
' This is the rich text field I want to copy the attachments to
Set attachInternal = doc.GetFirstItem("InternalMailAttachment")
' Check field exists
If attachInternal Is Nothing Then
Msgbox "There is no field called 'InternalMailAttachment' saved in the document. Exiting now"
Exit Sub
End If
'Check item is of type RichText
If attachInternal.Type <> RICHTEXT Then
Msgbox "The field / item called 'InternalMailAttachment' is not a RichTextItem. Exiting now"
Exit Sub
End If
' This is the rich text field where the attachments are from the begining
Set desAttachments = doc.GetFirstItem("desAttachments")
' ensure it exists. If not create a new backend Item
If desAttachments Is Nothing Then
Set desAttachments = New NotesRichTextItem( doc, "desAttachments")
End If
' Ensure the item we got is of type rich text
If desAttachments.Type <> RICHTEXT Then
Msgbox "The field / item called 'desAttachments' is not a RichTextItem. Exiting now"
Exit Sub
End If
' do the attaching in the back end
Call attachInternal.AddNewline(1)
Call attachInternal.AppendText("Appending attachment here " & Format$( Now, "yyyy-mm-dd hh:ss") )
Call attachInternal.AddNewline(1)
Call attachInternal.AppendRTItem( desAttachments )
'To delete the items which were in desAttachments un comment the next line
Call desAttachments.Remove
' Save the changes in the back end.
Call doc.Save( True, False )
'Now to close the current UIDoc and then reopen it with the changed backend data
' Remove any messages about saving the document which may appear to the user
' But first check if there is a Saveoptions field and save the vlaue if there is
If doc.HasItem("SaveOptions") Then
oldSaveOptions = doc.SaveOptions(0)
End If
doc.SaveOptions = "0"
' Get a reference to the backend document notesID
noteId = doc.NoteID
' Close the current UIDoc
Call uidoc.Close(True)
'Get the document handle again from the backend DB using th eNotesID
Set doc = db.GetDocumentByID( noteID )
If doc Is Nothing Then
Msgbox "Unable to retrieve the document with Notes ID " & noteId & " from db " & db.Title
Beep
Exit Sub
End If
'We have the document again so ...
'Reset the Saveoptions item back to original value or else delete it
If oldSaveOptions <> "" Then
doc.SaveOptions = oldSaveOptions
Else
Call doc.RemoveItem("SaveOptions")
End If
Call doc.Save( True, False )
' Reopen the UIDoc in edit mode
Set uidoc = ws.EditDocument( True , doc, False,"", True,False)
Msgbox "We should now be finished wiuth the new attachments in place"
Exit Sub
errHandle:
Msgbox "An error occurred on line " & Cstr( Erl) & Chr$(13) & "and said " & Error$
Exit Sub