Remove design flags

On Error Resume Next
Exit sub
Call writeAgentNameToAgentLog ("Remove design flags")
Call logRT.AppendText("Starting Agent")
Call writeToAgentLog (logRT)

Dim s As New NotesSession
Dim db As NotesDatabase
Dim nc As NotesNoteCollection
Dim Flags As Variant
Dim noteid As String
Dim doc As NotesDocument
Dim dbdir As NotesDbDirectory
'Set dbdir =New NotesDbDirectory("CN=EU-WEB-APPS01/OU=Server/O=REMEA-EXT")
Set dbdir =New NotesDbDirectory("CN=UKLON01-Mail01/OU=Server/O=REMEA")

Set db = dbdir.GetFirstDatabase(DATABASE)
Do While Not db Is Nothing
Call db.Open("","")
If (Left(db.Filepath,5)="Mail\") Then
MsgBox "Remove design flags : " & db.title
Set nc = db.CreateNoteCollection(True) ' Select all note types...
nc.SelectDocuments=False ' ...except data documents.
Call nc.BuildCollection

noteid = nc.GetFirstNoteId
Do Until noteid=""
Set doc = db.GetDocumentByID(noteid)
flags = doc.GetItemValue("$Flags")(0)
if (InStr(flags, "P") > 0) Then
flags = Replace(flags, "P", "")
doc.ReplaceItemValue "$Flags", flags
doc.Save True, False, True
MsgBox db.title & ":  Removed P Flag from " & doc.GetItemValue("$Title")(0)
Call logRT.AppendText(db.title & ":  Removed P Flag from " & doc.GetItemValue("$Title")(0) )
Call writeToAgentLog (logRT)
End If
noteid = nc.GetNextNoteId(noteid)
Loop
End If
Set db = dbdir.GetNextDatabase
Loop

Call logRT.AppendText("Finished Archive Agent")
Call writeToAgentLog (logRT)


Exit Sub
ErrorThrower:
Error Err, Error & Chr(13) + "Module: " & CStr( GetThreadInfo(1) ) & ", Line: " & CStr( Erl )
Resume next