Hallo!
Ich bin gerade dabei, eine Notes-DB zu entwickeln, die Attachments aus den einzelnen Mails entfernen soll und in eine seperate Notes-DB schreiben soll. Das funktioniert so weit auch gut, nur wenn ich mir ein Mail ansehe wo mein Notesagent das Attachment schon gelöst hat, sehe ich noch immer das Icon vom Anhang. Wenn ich dann auf den Anhang klicke bringt Notes die Fehlermeldung: Element des Dokuments nicht gefunden. Das ist ja soweit auch in Ordnung, weil der Anhang auch nicht mehr da ist. Aber wie bekomme ich das Icon aus dem Mail-Dokument weg, nachdem ich
den Anhang daraus entfernt habe und den Anhang in einer neuen DB wieder als Anhang hinzugefügt habe.
Anbei noch den Code von dem Agenten, der dies erledigt:
Sub Initialize
Dim s As New Notessession
Dim cdb As Notesdatabase
Dim maildb As Notesdatabase
Dim MailFile As String, Server As String, Path As String, EmbedObj As String, Bar As String, Temp As String, saveFlag As String, AName As String
Dim view As NotesView
Dim doc As NotesDocument, newdoc As Notesdocument
Dim obj As NotesEmbeddedObject, newObj As NotesEmbeddedObject
Dim Attachments As Variant, AttachmentNames As Variant, AttachmentCount As Integer
Dim AllDocs As Long, cDoc As Long, Ergebnis As Long, aErgebnis As Long
Dim rtItem As Variant
Dim AttCount() As Integer, KillAttach() As Integer
Dim dc As NotesDocumentCollection
Set cdb = s.CurrentDatabase
saveFlag = „False“
MailFile = s.GetEnvironmentString(„MailFile“, True)
Server = s.GetEnvironmentString(„MailServer“, True)
Path = s.GetEnvironmentString(„Directory“, True)
Mkdir Path & „\Test“
Path = s.GetEnvironmentString(„Directory“, True) & „\Test“
If Server = „Lokal“ Then Server = „“
Set maildb = s.GetDatabase(Server, MailFile)
Set view = maildb.GetView("($All)")
Set doc = view.GetFirstDocument
Set dc = maildb.AllDocuments
cDoc = 1
Alldocs = dc.Count
Bar = „--------------------------------------------“&_
„--------------------------------------------------------“
Do Until doc Is Nothing
Ergebnis = 100 * cDoc / AllDocs
If Not aErgebnis = Ergebnis Then
Bar = Left( Chr(1) & Bar, 100 )
End If
Print cDoc & " Dokument(e) von " & AllDocs & " Dokument(e) bearbeitet (" & Ergebnis & „%) - " & Bar
Attachments = Evaluate(“@Attachments",doc) 'Gibt die Anzahl der Attachments zurück
AttachmentNames = Evaluate("@AttachmentNames",doc) 'Gibt den Attachment-Namen zurück
AttachmentCount% = 0
If doc.Hasembedded Then
If AttachmentCount% 0 Then
If saveFlag = „False“ Then
newdoc.form = „Dokument“
newdoc.From = doc.From(0)
If doc.Subject(0) = „“ Then
newdoc.Subject = „(kein Thema)“
Else
newdoc.Subject = doc.Subject(0)
End If
Set rtItem = New NotesRichTextItem(newdoc, „doclink“)
Call rtItem.Appenddoclink(doc, „“)
saveFlag = „True“
REM Bemerkung in bestehendes Dokument einfügen
Set rtItem = doc.GetFirstItem(„Body“)
Call rtItem.AddNewLine(1)
Call rtItem.AppendText(„Um die vorhandenen Dateianhänge zu öffnen, bitte hier klicken -->“)
Call rtItem.AppendDoclink(newdoc,„Bitte einmal klicken, um den Dateianhang zu öfnen!“)
Call doc.Save(True,True,True)
End If
Set obj = doc.GETATTACHMENT(AttachmentNames(Attachmentcount%))
Call obj.ExtractFile(Path & „“ & obj.Name)
Call obj.Remove
Call doc.Save(True,True,False)
Attachmentcount%=Attachmentcount%+1
End If
Wend
'If doc.Hasembedded Then
Set rtItem = newdoc.GetFirstItem(„Body“)
Temp$ = Dir$(Path & „*.*“,0)
REM Alle gelöste Dokumente anhängen
Do While Temp$ „“
Set newobj = rtItem.EmbedObject(EMBED_ATTACHMENT, „“, Path & Temp)
Temp$ = Dir$()
Loop
REM Alle gelösten Dokumente von der Festplatte löschen
Temp$ = Dir$(Path & „*.*“,0)
Do While Temp$ „“
Kill Path & Temp$
Temp$ = Dir$()
Loop
Call newdoc.Save(True,True)
End If
Set doc = view.GetNextDocument(doc)
cDoc = cDoc + 1
aErgebnis = Ergebnis
saveFlag = „False“
Loop
Rmdir Path
Print „Die Verarbeitung wurde erfolgreich abgeschlossen!“
End Sub
Vielen Dank für euer Hilfe.
Gruß
Peter