Sub Click(Source As Button)
     
     Dim session As New NotesSession
     Dim workspace As New NotesUIWorkspace
     
     Dim db As NotesDatabase
     Set db = session.CurrentDatabase
     
     Dim Doc1 As NotesDocument
     
     Dim tDoc As NotesDocument    
     Set tDoc = db.CreateDocument 
     
     '******************Set Collection to selected docs in view *******************************
     Dim collect As NotesDocumentCollection
     Set collect = db.UnprocessedDocuments
     
     '******** If there are no documents selected, prompt the user and exit the script ****************
     If collect.count = 0 Then
          Msgbox " No Document(s) selected!", 0 + 64
          Exit Sub
     End If
     
     '****If the collection contains only 1 doc then extract from doc1, else loop thru all docs & extract all*****
    
     If collect.count = 1 Then              ' ******** Used if only one doc has been selected. ********
          Set Doc1 = collect.GetFirstDocument
          Call Doc1.CopyAllItems(tDoc, False)     ' Copy all fields from Source Doc to Target Doc
          Forall i In tDoc.items                                 ' Loop thru all fields and remove any that are not attachments
               If i.name="$FILE" Then
               Else
                    Call tDoc.RemoveItem(i.name)
               End If
          End Forall
          tdoc.Subject = Doc1.mt_name(0)  
     Else            ' ******** Else used if more than one doc has been selected. ********
          Set Doc1 = collect.GetFirstDocument
          Do 
               Call Doc1.CopyAllItems(tDoc, False)          ' Copy all fields from Source Doc to Target Doc
               Forall i In tDoc.items                                        ' Loop thru all fields and remove any that are not attachments
                    If i.name="$FILE" Then
                    Else
                         Call tDoc.RemoveItem(i.name)
                    End If
               End Forall
               Set Doc2 = collect.GetNextDocument(Doc1)
               Set Doc1 = Doc2
          Loop Until Doc1 Is Nothing
     End If
     
     tDoc.Form = "Memo"        ' Set the form field to memo, allowing correct viewing on other PCs.
     
     '*************Open tDoc as NotesUIDocument**************************
     Dim ws As New notesuiworkspace
     Dim uidoc2 As notesuidocument
     Set uidoc2 = ws.EditDocument(True, tDoc ) 
     
End Sub