Parcourir un disque dur et detecter les boites d'archive

[billbock]

Code : Tout sélectionner

Sub Parcoursdrive(path As String)
path est le disque parcouru (ex : D:\)
   On Error Goto er
   Dim pathname As String
   Dim repname As String
   Dim filename As String
   Dim dbTraite As NotesDatabase
   Dim inbox As NotesView
   Dim sent As NotesView
   Dim DirList As Variant
   Dim j As Integer
   Dim k As Integer
   Redim DirList(0)
   Dim sep As String
   If Instr(sess.Platform, "Windows") > 0 Then
      sep = "\"
   Else
      sep = "/"
   End If
   Print path
   
   Chdir(path)
      'pour chaque rep recuperation des fichiers nsf
   'recup nom modele et <> id replique
   'si identique> archive
   pathName$ = path+"*.nsf"
   fileName$ = Dir$(pathName$, 0)
   Do While fileName$ <> ""
      Set dbTraite = sess.GetDatabase("",path + "\" + filename)
      If  dbTraite.IsOpen Then
         'test si id replique identique
         If idreplica = dbTraite.ReplicaID Then
            Goto suite
         End If
         'test presence $Inbox
         Set inbox = dbtraite.GetView("$Inbox")
         If inbox Is Nothing Then Goto suite
         'test presence $sent
         Set sent = dbtraite.GetView("$Sent")
         If sent Is Nothing Then Goto suite
         'test template mailbox via template name
         If  iEntryInList(dbtraite.DesignTemplateName,listtemplate) = 0 Then Goto suite
         Call addtoarray(listeArchive,a)
         listeArchive(a) = dbTraite.FilePath
      End If
suite :
      fileName$ = Dir$()
   Loop
   
   repname = Dir(path, 16)
   Do While repname <> ""
      k=k+1
      If(repname <> ".")And(repname<>"..") Then
         If FileExist(path+repname) = False Then
            Parcoursdrive(path+repname + sep)
            Chdir(path)
         Else
            'Exit Sub
         End If
         
      End If
      repname = Dir(path, 16)
      For j = 1 To k
         repName$ = Dir$()
      Next
      
   Loop
   Exit Sub
er :
   Resume Next
   
   
End Sub