Dans la série "un p'tit script qui pourrait ben vous servir un jour" (un peu comme le Show n Tell Thursdays mais à la sauce de la France), voici un agent qui extrait dans un fichier texte les bases du répertoire mail qui ne sont pas référencées dans les documents personnes. En gros cet agent vous sort toutes les bases que vous avez oublié de supprimer (ou mal supprimé) aprés le départ de vos collègues.

Sub Initialize
    
    Dim session As New notessession
    Dim dbcurrent As notesdatabase
    Dim view As notesview
    Dim entry As NotesViewEntry
    Dim item As Notesitem
    Dim itemText As String 
    Dim vc As NotesViewEntryCollection
    Dim dirDBArray() As String
    Dim usersDBArray() As String
    
    Dim db As NotesDatabase
    Dim intExportFile As Integer
    
    Set dbcurrent = session.currentdatabase 
    Dim dbdir As New NotesDBDirectory(dbcurrent.server)
    
    intExportFile = Freefile
    Open "c:\temp\ExportFile.txt" For Output As intExportFile
    
    ' Récupération des bases dans le répertoire mail
    i%=0
    Set db = dbdir.GetFirstDatabase (DATABASE)
    Do Until db Is Nothing
        If Lcase(Left(db.FilePath, "5")) = "mail\" Then
            i%=i%+1
            Redim Preserve dirDBArray(i%)
            dirDBArray(i%-1)=Lcase(replaceSubstring( db.FilePath,".nsf",""))
        End If
        Set db = dbdir.GetNextDatabase
    Loop    
    
    Set view = dbcurrent.getview("People")
    Set vc = view.AllEntries
    
    ' Récupération des fichiers mails des documents personne
    i%=0
    Set entry = vc.GetFirstEntry()
    While Not entry Is Nothing
        If Lcase(Left(entry.document.mailfile(0), "5")) = "mail\" Then
            i%=i%+1
            Redim Preserve usersDBArray(i%) 
            usersDBArray(i%-1)=Lcase(entry.document.mailfile(0))
        End If
        Set entry = vc.getnextEntry(entry)
    Wend
    
    ' Comparaison des deux tableaux et extractions dans le fichiers texte
    For x% = Lbound(dirDBArray)To Ubound(dirDBArray) 
        y%=0
        found%=0
        For y% = Lbound(usersDBArray)To Ubound(usersDBArray)
            If dirDBArray(x%)=usersDBArray(y%) Then
                found%=1
                Exit For
            End If 
        Next
        If found%=0 Then
            Write #intExportFile, dirDBArray(x%)
        End If
    Next
    
    
    Close #intExportFile
    
End Sub 

Function ReplaceSubstring( Byval s1 As String, s2 As String, s3 As String) As String
Dim index%

index = Instr( s1, s2 )
If index = 0 Then
ReplaceSubstring = s1
Else
ReplaceSubstring = Left$(s1, index - 1 ) & s3 & ReplaceSubstring(Right$(s1, Len(s1) - (index + Len(s2)) + 1 ), s2, s3 )
End If
End Function

A noter que cet agent est à créer dans votre carnet d'adresse.
A noter aussi que pour faire cette extraction je me base sur la vue "People", je ne m'occupe donc pas des bases de courrier en arriver.
A noter encore que si vous avez plusieurs serveurs mails, vous devez l'exécuter sur chaque serveur.

Cet agent est à exécuter par le client et demande très peu de ressource au serveur. Il est compatible V5, V6, V7.

No documents found