Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim tempdoc As NotesDocument
Set db = session.currentDatabase
Dim uidoc As NotesUIDocument
Set uidoc = ws.currentdocument
Set doc = uidoc.document
If (IsOverLimit) Then
Exit Sub
End If
If doc.HasEmbedded = False Then
Call ws.ComposeDocument("","","Reply With History")
Exit Sub
End If
Dim count As Integer
Dim item As NotesRichTextItem
Set item=doc.getFirstItem("body") ' get body
count = 0
If Not (item Is Nothing) Then
xx = item.embeddedObjects
If Isarray(xx) Then
Forall x In item.embeddedObjects
If x.type=1454 Or x.type = 1453 Or x.type = 1452 Then
count = 1
End If
End Forall
End If
End If
If count = 0 Then
Call ws.ComposeDocument("","","Reply With History")
Exit Sub
End If
Set tempdoc = New NotesDocument(db)
Set item=doc.getFirstItem("body") ' get rid of attachments from backgroud document
Forall x In item.embeddedObjects
If x.type=1454 Or x.type = 1453 Or x.type = 1452 Then
x.remove
End If
End Forall
Call uidoc.close
doc.AttachmentsDeletedMsg = "*******Attachment(s) have been removed*******"
Call doc.CopyAllItems(tempdoc,True)
Call tempdoc.MakeResponse( doc)
Call tempdoc.Save(True,False)
Set uidoc = ws.EditDocument(True,tempdoc)
Set anotheruidoc = ws.ComposeDocument("","","Reply With History")
Dim refitemintempdoc As NotesItem
Set refitemintempdoc = tempdoc.GetFirstItem("$REF")
Dim refitem As NotesItem
Set refitem = refitemintempdoc.CopyItemToDocument( anotheruidoc.document,"$REF")
Call uidoc.close
Call tempdoc.Remove(True)
End Sub