Hi,
wir haben das vor der Migration der Mail-DBs auf R5 mit folgendem Script erledigt :
Dim s As New NotesSession
Dim db As NotesDatabase
Dim uniqid As String
Dim count As Integer,count2 As Integer,count3 As Integer,count4 As Integer, count5 As Integer
Dim emaildbs As String
Dim okay, fehler As String
Dim dbPath As String, dbName As String, ViewName As String, ViewArray As String,CorrectedViews As String
Set db = s.CurrentDatabase
dbPath = db.FilePath
dbName = dbPath
While dbPath <> ""
count = 0
count2 = 0
count3 = 0
count4 = 0
count5 = 0
CorrectedViews = ""
Forall Views In db.Views
If Views.IsFolder Then
ViewName = Views.Name
count = count + 1
Print "Prüfung [" & ViewName & "] --- ( " & Cstr(count2) & " von "_ & Cstr(count-1) & " Ordnern korrigiert )"
uniqid = Views.UniversalID
Set doc = db.GetDocumentByUNID(uniqid)
Set flags = doc.GetFirstItem("$Flags")
If ViewName = "($Inbox)" Or ViewName = "($Trash)" Or ViewName_
= "($Alarms)" Then
If (flags.Text Like "*P*") Then
Dim flagziel As String
Call FindAndReplace(flags.Text, flagziel, "P", "")
flags.Values = flagziel
Call doc.Save(True, False)
count3 = count3 + 1
End If
Else
If Not (flags.Text Like "*P*") Then
flags.Values = flags.Text & "P"
Call doc.Save(True, False)
count2 = count2+1
CorrectedViews = CorrectedViews & ViewName
Else
count4 = count4+1
End If
End If
End If
End Forall
dbPath = ""
Wend
Dim text As String
text = "Datenbank : " & Cstr(dbName) & Chr$(13) & _
"Es wurden insgesamt " & Cstr(count) & " Ordner geprüft. Davon_
wurden " & Cstr(count2) & " korrigiert." & Chr$(13) & Chr$(13) & _
"Korrigierte Ordner : " & CorrectedViews & Chr$(13) & Chr$(13) & _
"korrigierte Standardordner : " & Cstr(count3)
'Dim mdb As New NotesDatabase_
("Server","mail.box")
Dim d As notesdocument
Set d = New notesdocument(db)
d.form = "Memo"
d.Subject = "Ergebnis ProtectAgainstUpdate"
d.Body = text
d.SendTo = "lnadmin"
Call d.send(False)
Hier noch die Funktion FindAndReplace :
Function FindAndReplace(Byval Source As String, Target As String,_
Find As String, Replace As String) As Integer
Dim tmpSubString As String
On Error Goto FindAndReplaceError
Target$ = ""
tmpSubString$ = Source$
positionOfChar& = Instr(1, Source$, Find$ )
While positionOfChar& > 1
Target$ = Target$ & Left$(tmpSubString$, positionOfChar& -1)_
& Replace$
tmpSubString$ = Right$(tmpSubString$, (Len(tmpSubString$)_
- positionOfChar& - Len(Find$) + 1))
positionOfChar& = Instr(1, tmpSubString$, Find$ )
Wend
Target$ = Target$ & tmpSubString$
FindAndReplace = True
Exit Function
FindAndReplaceError:
Print Error$ & " (ID = " & Cstr (Err) & ", Line = " & Cstr (Erl) & ")", 0, "FindAndReplace"
FindAndReplace = False
Resume EndFunction
EndFunction:
End Function