Hi zusammen
Da hier ja schon fast eine Sammlung von Querydocumentdelete Codebeispielen entsteht auch mein Senf noch dazu.
Sub Querydocumentdelete(Source As Notesuidatabase, Continue As Variant)
Dim ws As New NotesUIWorkspace
Dim session As New NotesSession
Dim docsToDelete As NotesDocumentCollection
Dim docs As NotesDocumentCollection
Dim doc As NotesDocument
Dim responses As NotesDocumentCollection
Dim response As notesdocument
Dim intAnswer As Integer
Continue=False
Set docsToDelete=Source.Database.GetProfileDocCollection("proDummy")
Set docs=Source.Documents
Set doc=docs.GetFirstDocument
Do Until doc Is Nothing
CreateTrashCollection doc,docsToDelete
docsToDelete.AddDocument doc
Set doc=docs.GetNextDocument(doc)
Loop
If docsToDelete.Count=1 Then
intAnswer=Msgbox ("Es steht ein Dokument zur Löschung an. Fortfahren?",4+32, "Bestätigung zum Löschen von Dokumenten")
Else
intAnswer=Msgbox ("Es stehen " & docsToDelete.Count & " Dokumente zur Löschung an. Fortfahren?",4+32, "Bestätigung zum Löschen von Dokumenten")
End If
If intAnswer=6 Then
docsToDelete.StampAll "fdDeleter",session.UserName
docsToDelete.StampAll "fdDeleted",Now
docsToDelete.RemoveAll False
If Not ws.CurrentView Is Nothing Then
ws.ViewRefresh
End If
End If
End Sub
Sub CreateTrashCollection(doc As NotesDocument,docsToDelete As NotesDocumentCollection)
Dim docsResponses As NotesDocumentCollection
Dim docResponse As NotesDocument
Set docsResponses=doc.Responses
If Not doc.Responses Is Nothing Then
Set docResponse=docsResponses.GetFirstDocument
Do Until docResponse Is Nothing
CreateTrashCollection docResponse,docsToDelete
docsToDelete.AddDocument doc
Set docResponse=docsResponses.GetNextDocument(docResponse)
Loop
End If
End Sub
Gruss
Remo