Bonjour,

Je cherche à classer des fichiers dans des dossiers. Le soucis est que je ne connais pas forcément le cheminement complet.
Il y 2 niveaux de classement que je ne métrise pas.
J'ai pourtant une piste mais n'arrive pas à un résultat satisfaisant. J'ai essayé de modifier un code qui à la base est prévu pour lister tous les sous dossier d'un répertoire.

Mon besoin:


Le classement

:connu1\connu2\INCONNU 1\ INCONNU 2\

l'inconnu 1 commence forcement par un code en 4 chiffre "1234" appelé code CI contenu dans ma variable "CodeCI" => CodeCI & "*"

:connu1\connu2\INCONNU 1\ 1234 blablabla\

l'inconnu 2 contient forcement un texte contenu dans ma variable "Classement" => "*" & Classement & "*"

Par exemple, le dossier peut etre "Client" ou "Clients" ou" Correspondance clients"...

Mon code

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub TrouvDossier()
 
 
If NoPost = "42" Then
Poste = "D:\LBM" & NoPost & "\"
 
End If
 
If NoPost <> "42" Then
Poste = "\\LBM" & NoPost & "\lbm" & NoPost & "\"
 
End If
 
 
 
DossierDepart = Poste & Tipe
 
 
 
  TousLesDossiers DossierDepart, 0 'appel de la procedure
 
   'MsgBox "1: " & CheminNoCI
 
 
 
  If CheminNoCI Like ("*" & CodeCI & "*") Then
  'If CheminNoCI Like (CodeCI & "*") Then
 
   MsgBox "2: " & CheminNoCI & "     Le chemin contient le code"
 
    CheminClassement = CheminNoCI & "\" & Classement
 
    End If
 
     If Dir((CheminClassement), vbDirectory) <> "" Then
 
         MsgBox "3: " & CheminClassement
 
   End If
 
   'D:\LBM42\AFFAIRES\Inconu\1906 Modif debox Hab 37.5 std 75 blason\FOURNISSEURS
 
End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub TousLesDossiers(LeDossier$, Idx As Long)
    Dim FSO As Object, Dossier As Object
    Dim sousRep As Object, Flder As Object
 
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FSO.GetFolder(LeDossier)
 
 
    'examen du dossier courant
    For Each Flder In Dossier.SubFolders
 
 
        'Idx = Idx + 1
        'Cells(Idx, 1).Value = Flder.Path
 
           If Flder.Path Like ("*" & CodeCI & "*") Then 'Si on trouve le bon dossier, alors on arrête
           'If Flder.Path Like (CodeCI & "*") Then  'Si on trouve le bon dossier, alors on arrête
 
               CheminNoCI = Flder.Path
 
              ' MsgBox "11 " & CheminNoCI
                Exit Sub
 
            End If
 
 
    Next
    'traitement récursif des sous dossiers
    For Each sousRep In Dossier.SubFolders
        TousLesDossiers sousRep.Path, Idx
    Next sousRep
    Set FSO = Nothing
End Sub

Ici le code entre dans tous les sous dossiers, ce qui me fait prendre parfois un temps fou alors que j'aimerai qu'il ai voir au niveau n-2

Quelqu'un peut-il m'aider?

Merci
Walter