Hallo alle zusammen,
Unten habe ich meinen aktuellen Script eingefügt. der Ist nicht ganz fertig ....
Ich Erläutere kurz mal die aktuelle Situation. Die UserArchivmails sind "tot". Deswegen soll ein Agent auf Mail Journaling Datenbank die ganzen Mails lesen und diese dem Userarchiv Maildatenbank verschieben. Die Userarchive setzten sich so zusammen: a_GMuell.nsf zusammen a_ für archiv G (Erster Buchstaben vom Namen) und Muell(die nächsten 5 Buchstaben vom Fam. Namen)
Ich habe eine Ansicht gebaut wo ich die Empfängernamen der Mails sehe, da ist mir aufgefallen, dass Namen unterschiedlich drin stehen z.B. Gerd Mueller, 'Hans_Peter', "Siegfried Maurer" etc....
Sub Initialize
Dim session As New NotesSession
Dim oDoc As NotesDocument
Dim archiveDb As New NotesDatabase( "", "" )
Dim oProfilDoc As NotesDocument
Dim db As NotesDatabase
Dim oView As NotesView
Dim collection As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim nAnz As Long
Dim oD1 As NotesDateTime
Dim cText As String, cServer As String, cDatabase As String, cError As String
Dim cProfServer As String
On Error Goto AgentError
Set db = session.Currentdatabase
Set oProfilDoc = db.GetProfileDocument("PDAllgemein")
Set oView = db.GetView("vwKopieUserArchiv") ' *** Ansicht alle eingehende Mails
Set collection = oView.AllEntries
Set entry = collection.GetFirstEntry()
Set oD1 = New NotesdateTime(Date$)
cServer = "ISP02/Firma/De"
cProfServer = oProfildoc.GetItemValue("fdPrServer")(0)
cDatabase = "Applikationen\kural\a_"
Call archiveDb.Open( cServer , cDatabase ) ' *** Archivdatenbank
' *** Start Verschiebung Mails nach Username ----> ab hier weiss ich nemme weiter
While Not(entry Is Nothing)
On Error Goto LoopError
Set oDoc = entry.Document
Call oDoc.CopyToDatabase( archiveDb ) ' *** Kopiere Doc aus Ansicht in ArchivDB
oDoc.Remove(True) ' *** Lösche Doc aus bestehender Datenbank
nAnz = nAnz + 1
Print Cstr(nAnz)
Goto LoopWeiter
LoopError:
Resume LoopWeiter
LoopWeiter:
Set entry = collection.GetNextEntry(entry)
Wend
If nAnz = 0 Then ' *** Wenn keine Dokumente gefunden, keine Verarbeitung
Goto AllesEnde
End If ' *** nAnz = 0
Goto AllesEnde
AgentError:
Resume Next
AllesEnde:
End Sub