title image


Smiley Re: ($Inbox) korrupt?!
Hallo,



verwende für diese Zwecke seit langem ein Script. Basiert auf einer Routine "Find Unfiled" von "Patrick Gordner Consulting" aus 1998/1999. Hab ihn nur übersetzt.



Läuft durch die komplette DB und schiebt alle Mails, die nicht in einem Ordner einsortiert sind, in einen neuen Ordner.



Dauert je nach DBGröße etwas, ist aber sehr hilfreich.



Hier der Code:





'10 - Ungeordnete finden...:



Option Public

Option Declare



'---- A list used for finding the Note ID's of unfiled messages (not in any folder)

Dim nDocs% List



Dim session As NotesSession

Dim uiws As NotesUIWorkspace

Dim db As NotesDatabase

Dim dcMessages As NotesDocumentCollection

Dim nProcessed%

Dim nIsFolderNew%



'---- Messages used throughout the agent

Const sAGENT_NAME = "Ungeordnete finden"

Const sDEF_FOLDER = "--> Ungeordnete Mails"



Const sCFRM_BEGIN = "Diese Funktion kann einige Minuten dauern. Möchten Sie fortfahren?"

Const sCFRM_FOLDERS_1 = "Beim Bearbeiten folgender Ordner sind Fehler aufgetreten: "

Const sCFRM_FOLDERS_2 = " ! Möchten Sie die Fehler ignorieren und fortfahren?"

Const sCFRM_CLEAR_1 = "Fehler beim Leeren des Ordners '"

Const sCFRM_CLEAR_2 = "' ! Möchten Sie trotzdem fortfahren?"



Const sERR_NO_MATCH = "Keine Dokumente entsprachen den Suchkriterien!"

Const sERR_NO_DOCSLIST = "Fehler beim Erstellen einer Liste aller Nachrichten. " &_

"Möglicherweise überschreitet die Anzahl aller Nachrichten bestehen Datenlimits."

Const sERR_PROCESS_1 = "Ein Fehler ist aufgetreten beim Verschieben von Dokumenten in den Ordner '"

Const sERR_PROCESS_2 = "'. Der Zielordner beinhaltet möglicherweise nicht alle ungeordnete Nachrichten!"



Const sPRNT_CREATE_COLL = "Erstelle eine Liste aller zu bearbeitender Nachrichten ...."

Const sPRNT_GET_FIRST_VIEW = "Bearbeite erste Ansicht ...."

Const sPRNT_GET_NEXT_VIEW = "Bearbeite nächste Ansicht zu "

Const sPRNT_CLEAR_FOLDER = "Leere Ordner '"

Const sPRNT_READ_LIST = "Lese alle Nachrichten: "

Const sPRNT_PROC_FOLDER = "Bearbeite Nachrichten in Ordner '"

Const sPRNT_MOVE_FIRST = "Verschiebe Nachrichten in Ordner '"

Const sPRNT_MOVE_STATUS_1 = "Verschiebe Nachricht "

Const sPRNT_MOVE_STATUS_2 = " in Ordner '"



Const sMSG_STORE_IN = "Verschieben der ungeordnete Nachrichten nach: "

Const sMSG_FINAL = " ungeordnete Nachrichten wurden gefunden und in folgenden Ordner verschoben: '"

Const sMSG_NEW_FOLDER = "Dies ist ein neuer Ordner. Bitte schließen und öffnen sie die Datenbank erneut!"

Const sMSG_NO_UNFILED = "In dieser Datenbank wurden keine ungeordneten Nachrichten gefunden!"





Sub Initialize



' ------------------------------------------------------------------------------------------------------------------------------

' Agent Name: Find Unfiled

' Application: Mail

' Inputs: None

' Outputs: None

'

' Description: Finds all message in a mail database and folders those

' which weren't foldered yet into a special folder (user choice)

' Special Logic: None

' Comments: None

' ------------------------------------------------------------------------------------------------------------------------------

' Modification Log:

' 02/12/1999 - P. Gordner - Removed Integer limit in InstantiateDocsList

' 03/12/1998 - P. Gordner - Initial Release

' ------------------------------------------------------------------------------------------------------------------------------

' © 1998, 1999 Patrick Gordner Consulting

' ------------------------------------------------------------------------------------------------------------------------------



Dim dtCutOff As New NotesDateTime("")

Dim viewCheck As NotesView

Dim viewUnfiled As NotesView

Dim x%, nErrFolders%, sErrFolders$, sSearch$

Dim sFolderName$



Set session = New NotesSession

Set uiws = New NotesUIWorkspace

Set db=session.CurrentDatabase



If Msgbox(sCFRM_BEGIN,36,sAGENT_NAME)=7 Then

Exit Sub

End If



sFolderName=Trim(Inputbox$(sMSG_STORE_IN, sAGENT_NAME, sDEF_FOLDER))



If sFolderName="" Then

Exit Sub

End If



'----- Get all messages (memos & replies) into one document collection

'----- The search string considers memos and replies, and excludes all docs in the draft view

'----- we might need to consider docs with "store form in document" ?

sSearch="Form=""Memo"":""Reply"" & !( PostedDate = """" & $MessageType = """" & !(ExcludeFromView = ""D"") )"

Print sPRNT_CREATE_COLL

Set dcMessages=db.Search(sSearch, dtCutOff, 0)

If dcMessages Is Nothing Or dcMessages.Count=0 Then

Msgbox sERR_NO_MATCH, , sAGENT_NAME

Exit Sub

Else

If Not InstantiateDocsList Then

Msgbox sERR_NO_DOCSLIST, , sAGENT_NAME

Exit Sub

End If

End If



'----- Clear the unfiled folder

If Not ClearUnfiledFolder(sFolderName) Then

If Msgbox( sCFRM_CLEAR_1 & sFolderName & sCFRM_CLEAR_2, 36 , sAGENT_NAME ) = 7 Then

Exit Sub

End If

End If



'---- Iterate through all the views & folders and process them

'---- We only want to be looking at non-hidden folders in our case

nErrFolders=False

For x=0 To Ubound(db.Views)

If viewCheck Is Nothing Then

Print sPRNT_GET_FIRST_VIEW

Else

Print sPRNT_GET_NEXT_VIEW & viewCheck.Name & " ...."

End If

Set viewCheck=db.Views(x)

If viewCheck.IsFolder And Left(viewCheck.Name,1) "(" Then

If Not ProcessFolder(viewCheck) Then

'---- If there was an error processing this folder, note it down

nErrFolders=True

If sErrFolders="" Then

sErrFolders=viewCheck.Name

Else

sErrFolders=sErrFolders & ", " & viewCheck.Name

End If

End If

End If

Next



'---- Check if there were any errors during the procession of folders

'---- and ask if the user wants to continue (if applicable)

If nErrFolders Then

If Msgbox(sCFRM_FOLDERS_1 & sErrFolders & sCFRM_FOLDERS_2, 36, sAGENT_NAME)=7 Then

Exit Sub

End If

End If



'----- Move all docs collected in nDocs into unfiled folder

If Not ProcessDocsList(sFolderName) Then

Msgbox sERR_PROCESS_1 & sFolderName & "'. " & sERR_PROCESS_2, , sAGENT_NAME

Exit Sub

End If



'----- Refresh the view, could be necessary if the user was in the unfiled folder at execution time

Call uiws.ViewRefresh



Print ""



If nProcessed=0 Then

Msgbox sMSG_NO_UNFILED , , sAGENT_NAME

Elseif nIsFolderNew Then

Msgbox Cstr(nProcessed) & sMSG_FINAL & sFolderName & "'" & Chr(13) & sMSG_NEW_FOLDER , , sAGENT_NAME

Else

Msgbox Cstr(nProcessed) & sMSG_FINAL & sFolderName & "'", , sAGENT_NAME

End If





End Sub



Function InstantiateDocsList() As Integer



' This function collects all NoteID's of the dcMessages document collection

' and writes them to the list



Dim doc As NotesDocument

Dim docNext As NotesDocument

Dim lCount&, lTotal&



On Error Goto ErrorTime

InstantiateDocsList=False



lTotal=dcMessages.Count

lCount=0



Set doc = dcMessages.GetFirstDocument

Do While Not doc Is Nothing

lCount=lCount+1

Print sPRNT_READ_LIST & Format$(lCount * 100 / lTotal, "00") & "%"

nDocs(doc.NoteID)=True

Set docNext=dcMessages.GetNextDocument(doc)

Set doc=docNext

Loop



InstantiateDocsList=True

Exit Function



ErrorTime:



Exit Function



End Function

Function ProcessFolder(viewCheck As NotesView) As Integer



' This function iterates through all the documents in the folder an

' removes the NoteID from the list nDocs



Dim doc As NotesDocument

Dim docNext As NotesDocument



On Error Goto ErrorTime

ProcessFolder=False



Print sPRNT_PROC_FOLDER & viewCheck.Name & "'"



Set doc=viewCheck.GetFirstDocument

Do While Not doc Is Nothing

If Iselement(nDocs(doc.NoteID)) Then Erase nDocs(doc.NoteID)

Set docNext=viewCheck.GetNextDocument(doc)

Set doc=docNext

Loop



ProcessFolder=True

Exit Function



ErrorTime:



Exit Function



End Function

Function ProcessDocsList(sFolder) As Integer



' This function iterates through all NoteID's collected in nDocs

' and moves them to the specified folder



Dim doc As NotesDocument



On Error Goto ErrorTime

ProcessDocsList=False

Print sPRNT_MOVE_FIRST & sFolder & "' ...."



nProcessed=0

Forall i In nDocs

Set doc=db.GetDocumentByID(Listtag(i))

If Not doc Is Nothing Then

doc.PutInFolder(sFolder)

nProcessed=nProcessed+1

Print sPRNT_MOVE_STATUS_1 & Cstr(nProcessed) & sPRNT_MOVE_STATUS_2 & sFolder & "' ...."

End If

End Forall



ProcessDocsList=True

Exit Function



ErrorTime:



Exit Function



End Function

Function ClearUnfiledFolder(sFolder) As Integer



' This function removes all documents from the specified folder



Dim viewUnfiled As NotesView

Dim doc As NotesDocument



On Error Goto ErrorTime

ClearUnfiledFolder = False



Set viewUnfiled=db.GetView(sFolder)



'--- If the folder does not exist, we have to quit immediately

If viewUnfiled Is Nothing Then

ClearUnfiledFolder=True

nIsFolderNew=True

Exit Function

End If



nIsFolderNew=False

Print sPRNT_CLEAR_FOLDER & sFolder & "' ...."



'---- remove the docs by always getting the first one

Set doc=viewUnfiled.GetFirstDocument

Do While Not doc Is Nothing

Call doc.RemoveFromFolder(sFolder)

Set doc=viewUnfiled.GetFirstDocument

Loop



ClearUnfiledFolder = True

Exit Function



ErrorTime:



Exit Function



End Function








CU,

Axel



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: