Hallo,
dieses kleine Script soll in allen selektierten eMails das Attachment löschen.
Dim session As New NotesSession
Dim col As NotesDocumentCollection
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim msgvalue As Variant
msgvalue = Msgbox("You are about to delete all attachments from the selected eMails"_
& Chr(10) & "Continue deleting attachments?",4+32,"Delete attachments")
If msgvalue = 6 Then
Set col = session.CurrentDatabase.UnprocessedDocuments
Set doc = col.GetFirstDocument
While Not (doc Is Nothing)
Set rtitem = doc.GetFirstItem( "Body" )
If ( rtitem.Type = RICHTEXT ) Then
If Not (Isempty (rtitem.EmbeddedObjects)) Then
Forall x In rtitem.EmbeddedObjects
If ( x.Type = EMBED_ATTACHMENT ) Then
Call x.Remove
Call doc.Save(True,False,False)
End If
End Forall
End If
End If
Set doc = col.GetNextDocument(doc)
Wend
End If
Das funktioniert auch problemlos wenn ich den Agent mit der Option Action menu selection
direkt aus dem Action Menu ausführe.
Starte ich den Agent aber über einen Dialog, der hiermit aufgerufen wird, werden die Attachments
nicht gelöscht :-(
Dim Workspace As New NotesUIWorkspace
Dim DB As NotesDatabase
Dim Doc As NotesDocument
Set DB = Workspace.CurrentDatabase.Database
Set Doc = New NotesDocument(DB)
Button = Workspace.DialogBox("(TestDialogAttachments)", True,True,True, False,False, False, "Test - Attachment Actions",doc,True,True)
Aufgerufen wird der Agent im Dialog mittels einer Schaltfläche welche diese
Formel ausführt.
@Command([FileCloseWindow]);
@Command([ToolsRunMacro];"DeleteOnly")
Ich habe im Agent an der Stelle Call x.Remove mal eine MsgBox plaziert und wollte mir
"nur" mal zum testen einen Text ausgeben lassen, aber leider kommt die MsgBox nicht :-(
Ich gehe mal davon aus, dass dem Agent nachdem ich ihn über den Dialog gestartet habe
die Collection fehlt, wie kann ich ihm diese richtig "übergeben"?
Für jeden Tipp dankbar!
Gruß
Chris
