Recherche récursive

Signaler
Messages postés
177
Date d'inscription
mercredi 2 juin 2004
Statut
Membre
Dernière intervention
11 avril 2013
-
Messages postés
177
Date d'inscription
mercredi 2 juin 2004
Statut
Membre
Dernière intervention
11 avril 2013
-
Bonjour,

je suis en train de rechercher comment optimiser mon code et je pense que vous y parviendrez
sans trop de mal :-)

Voici mon problème :
je dois effectuer le comptage de tous les Fichiers contenus dans les répertoires OK et tous les Fichiers contenus dans les répertoires ANO de cette structure : 

   Rep_Init  
                  \LotA1\OK1
                             \OK2
                             \ANO1
                             \ANO2
                  \LotA2\OK1
                             \ANO1
                  \LotA3\OK1
                             \ANO1
                             \ANO2
                  \LotB1\OK1
                             \OK2
                  \LotB2\ANO1
                             \ANO2

Ne prenez pas peur ... voici mon source vraiment pas optimisé :-(

dim ano as long
dim ok as long
dim ind_rep as long
dim ind_rep_ano as long
dim ind_rep_ok as long
dim tab_rep() as string
dim tab_rep_ano() as string
dim tab_rep_ok() as string
dim fichier as string

ano= 0
ok= 0
ind_Rep = 0
ReDim Tab_Rep(0)
ReDim Tab_Rep_OK(0)
ReDim Tab_Rep_Ano(0)
fichier = Dir("c:", vbDirectory)
Do While fichier <> ""
   If Mid(fichier, 1, 3) = "Lot" Then
      Ind_Rep = Ind_Rep + 1
      ReDim Preserve Tab_Rep(Ind_Rep)
      Tab_Rep(Ind_Rep) = "c:" & fichier & ""
   End If
   fichier= Dir
Loop
   
Ind_Rep_OK = 0
Ind_Rep_ANO = 0
Ind_Rep = 0
Do Until Ind_Rep = UBound(Tab_Rep)
   Ind_Rep = Ind_Rep + 1
   fichier = Dir(Tab_Rep(Ind_Rep), vbDirectory)
   Do While fichier <> ""
      If UCase(Mid(fichier, 1, 2)) = "OK" Then
         Ind_Rep_OK = Ind_Rep_OK + 1
         ReDim Preserve Tab_Rep_OK(Ind_Rep_OK)
         Tab_Rep_OK(Ind_Rep_OK) = Tab_Rep(Ind_Rep) & fichier & ""
      Else
         If UCase(Mid(fichier, 1, 3)) = "ANO" Then
            Ind_Rep_ANO = Ind_Rep_ANO + 1
            ReDim Preserve Tab_Rep_Ano(Ind_Rep_ANO)
            Tab_Rep_Ano(Ind_Rep_ANO) = Tab_Rep(Ind_Rep) & fichier & ""
         End If
      End If
      fichier= Dir
   Loop
Loop
   
Ind_Rep_ANO = 0
Do Until Ind_Rep_ANO = UBound(Tab_Rep_Ano)
   Ind_Rep_ANO = Ind_Rep_ANO + 1
   fichier= Dir(Tab_Rep_Ano(Ind_Rep_ANO))
   Do While fichier<> ""
      ano = ano+ 1
      fichier = Dir
   Loop
Loop
    
Ind_Rep_OK = 0
Do Until Ind_Rep_OK = UBound(Tab_Rep_OK)
   Ind_Rep_OK = Ind_Rep_OK + 1
   fichier = Dir(Tab_Rep_OK(Ind_Rep_OK))
   Do While fichier<> ""
      ok=ok+ 1
      fichier= Dir
   Loop
Loop

Merci d'avance pour votre aide très précieuse !!!

MoreY

5 réponses

Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
Salut,
tu veux une fonction qui te retourne le nombre de fichier total ou bien tu veux le nombre dans les OK ET le nombres dans les ANO à part.

@+: Ju£i?n
Pensez: Réponse acceptée
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
Salut,
Voila le code qui te permet de retourne le nombre TOTAL théoriquement

Option Explicit

Private Sub Form_Load()
Dim Fso
Set Fso = CreateObject("Scripting.FileSystemObject")
MsgBox CountFiles(Fso.GetFolder("C:\Rep_Init\"))
End Sub<hr />

Private Function CountFiles(ByRef folCourant) As Long
   
Dim subFol

   'pout chaque répertoire contenu dans le
   'répertoire folCourant
   For Each subFol In folCourant.SubFolders
       'Si ed type LOTXXX on passe au niveau inférieur
       If UCase(Mid(subFol.Name, 1, 3)) = "LOT" Then
           CountFiles = CountFiles + CountFiles(subFol)
       End If
       'Si contient un repertoire ANOX
       If UCase(Mid(subFol.Name, 1, 3)) = "ANO" Then
           'Retourne le nombre de fichier du repertoire ANO
           CountFiles = CountFiles + subFol.Files.Count
       End If
       
       If UCase(Mid(subFol.Name, 1, 2)) = "OK" Then
           'Retourne le nombre de fichier du repertoire OK
           CountFiles = CountFiles + subFol.Files.Count
       End If
   Next
   Set subFol = Nothing
End Function , ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée
Messages postés
177
Date d'inscription
mercredi 2 juin 2004
Statut
Membre
Dernière intervention
11 avril 2013
1
Merci beaucoup Julien !

ton code est incontestablement optimisé :-) !!!

par contre au niveau ... temps de réponse ... y a un léger problème :-(
pour ~200 répertoires LOT, je récupère les compteurs avec mon code en 1min16
et le tiens au bout de 10 minutes n'avait pas encore atteint le 50ème répertoire...

pour info, il me faut deux compteurs séparés (OK et ANO) !

Merci encore pour ton aide !!!
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 Bonsoir à tous

Bonsoir "tulesais" et "jrivet",

Une variante de ton code, Julien:

Option Explicit
Dim objFso, rootPath, RootFolder, cptANO, cptOK
 
RootPath = "D:\Rep_Init"
 
Set objFso = CreateObject("Scripting.FileSystemObject")
Set RootFolder = objFso.GetFolder(RootPath)

Call SearchFolders(RootFolder, cptANO, cptOK)
 
MsgBox "Nombre de fichiers dans les répertoires ANO" &vbTab& cptANO &vbCrLf& _
       "Nombre de fichiers dans les répertoires OK " &vbTab& cptOK

Set objFso = Nothing
Set RootFolder = Nothing

Sub SearchFolders(ArgFolder, cptANO, cptOK)
    Dim subfolder

    For Each subfolder In ArgFolder.SubFolders
        If UCase(Mid(subFolder.Name, 1, 3)) = "ANO" Then
           cptANO = cptANO + subFolder.Files.Count
        ElseIf UCase(Mid(subFolder.Name, 1, 2)) = "OK" Then 
           cptOK = cptOK + subFolder.Files.Count
        End if
    
        Call SearchFolders(subfolder, cptANO, cptOK)
    Next
End Sub

jean-marc
Messages postés
177
Date d'inscription
mercredi 2 juin 2004
Statut
Membre
Dernière intervention
11 avril 2013
1
Merci beaucoup Jean-Marc !!!

par contre ... niveau temps de réponse ... on est toujours bien loin des 1min16 !!!

finalement, je pense garder mon code !

Encore merci pour toute votre aide !!!