Discussion :

[Gabout]

Bonjour,

Je cherche à créer une table contenant le nom des répertoires et des sous-répertoires d'une adresse.

Tout va bien sur le premier répertoire : son nom et les sous-répertoires existants sont créés dans 2 champs distincts (sauf qu'Access me crée les 2 fichiers cachés . et ..).

Je plante sur le deuxième répertoire. Je ne le lis pas !

Quelqu'un a-t-il une idée ?

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
 
Private Sub cmdGo_Click()
    Dim oRst As DAO.Recordset
    Dim oDb As DAO.Database
    Set oDb = CurrentDb
    Set oRst = oDb.OpenRecordset("Test", dbOpenTable)
    DoCmd.SetWarnings False
    DoCmd.RunSQL "delete * from Test"
    DoCmd.SetWarnings True
    Dim adresse As String
    Dim rep As String, sousrep As String
    adresse = "c:\"
    rep = Dir(adresse, vbDirectory)
    Do While (rep <> "")
        'If rep <> "." And rep <> ".." Then
            If (GetAttr(adresse & rep) And vbDirectory) = vbDirectory Then
                sousrep = Dir(adresse & rep & "\", vbDirectory)
                Do While (sousrep <> "")
                    'If sousrep <> "." And sousrep <> ".." Then
                        If (GetAttr(adresse & rep & "\" & sousrep) And vbDirectory) = vbDirectory Then
                            oRst.AddNew
                            oRst.Fields("Domaine").Value = rep
                            oRst.Fields("SousDomaine").Value = sousrep
                            oRst.Update
                        End If
                        sousrep = Dir
                    'End If
                Loop
            End If
            rep = Dir
        'End If
    Loop
    oRst.Close
    oDb.Close
    Set oRst = Nothing
    Set oDb = Nothing
End Sub

[LedZeppII]

Bonjour,

il faut utiliser une fonction recursive qui s'appelle elle même pour chaque sous répertoire.
On coupe donc le code en deux.

Code vb :

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
Private Sub ScanRep(adresse As String, oRst As DAO.Recordset)
Dim rep As String, sousrep As String
 
rep = Dir(adresse & "\*.*", vbDirectory)
Do While (rep <> "")
    If (rep <> ".") And (rep <> "..") And _
       ((GetAttr(adresse & "\" & rep) And vbDirectory) = vbDirectory) Then
        sousrep = rep
        oRst.AddNew
        oRst.Fields("Domaine").Value = adresse
        oRst.Fields("SousDomaine").Value = rep
        oRst.Update
        ScanRep adresse & "\" & rep, oRst
 
        ' on resynchronise la recheche après appel de ScanRep
        rep = Dir(adresse & "\*.*", vbDirectory)
        Do While rep <> sousrep
           rep = Dir()
        Loop
    End If
 
    rep = Dir()
Loop
 
End Sub

Code vb :

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
Private Sub cmdGo_Click()
    Dim oRst As DAO.Recordset
    Dim oDb As DAO.Database
 
    Set oDb = CurrentDb
    Set oRst = oDb.OpenRecordset("Test", dbOpenTable)
    DoCmd.SetWarnings False
    DoCmd.RunSQL "delete * from Test"
    DoCmd.SetWarnings True
 
    Dim adresse As String
    adresse = "C:\"
    ScanRep adresse, oRst
 
    oRst.Close
    oDb.Close
    Set oRst = Nothing
    Set oDb = Nothing
End Sub

A+

[Gabout]

Merci de ta réponse.

Cela colle assez bien mais je ne voulais conserver que les deux niveaux en dessous de l'adresse.

Exemple : pour une adresse C:\travail\

Répertoire.......Sous-répertoire
Etudes.............Plan de prévention
Etudes.............Document unique
Etudes.............CRM
Suivis..............Chantier 1
Suivis..............Chantier 2
Suivis..............Rapport 24

Peux-tu prolonger ta réflexion ?

Sinon grand merci, je vais de toute façon continuer à phosphorer sur ce problème.

[LedZeppII]

Ah d'accord.
Pour deux niveaux ton code était bon.
Il y a juste le fait que Dir(...) ne sait pas mener deux recherches en même temps (rep et sousrep).
Quand on quitte le niveau sousrep pour revenir au niveau rep, il faut recommencer la rechercher jusqu'à
la valeur rep (la boucle sous le commentaire 'Synchro), puis continuer.
J'en ai profité pour ajouter le cas ou un répertoire n'a pas de sous répertoire (If blnNiv2 = False)

Code vb :

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
44
45
46
47
48
49
50
51
Private Sub cmdGo_Click()
    Dim oRst As DAO.Recordset
    Dim oDb As DAO.Database
    Set oDb = CurrentDb
    Set oRst = oDb.OpenRecordset("Test", dbOpenTable)
    DoCmd.SetWarnings False
    DoCmd.RunSQL "delete * from Test"
    DoCmd.SetWarnings True
 
    Dim adresse As String
    Dim rep As String, sousrep As String, strTmp As String
    Dim blnNiv2 As Boolean
 
    adresse = "c:\"
 
    rep = Dir(adresse, vbDirectory)
    Do While (rep <> "")
        If rep <> "." And rep <> ".." And _
           (GetAttr(adresse & rep) And vbDirectory) = vbDirectory Then
            blnNiv2 = False
            sousrep = Dir(adresse & rep & "\", vbDirectory)
            Do While (sousrep <> "")
                If sousrep <> "." And sousrep <> ".." And _
                  (GetAttr(adresse & rep & "\" & sousrep) And vbDirectory) = vbDirectory Then
                    blnNiv2 = True
                    oRst.AddNew
                    oRst.Fields("Domaine").Value = rep
                    oRst.Fields("SousDomaine").Value = sousrep
                    oRst.Update
                End If
                sousrep = Dir
            Loop
            If blnNiv2 = False Then
                oRst.AddNew
                oRst.Fields("Domaine").Value = rep
                oRst.Update
            End If
            ' Synchro
            strTmp = Dir(adresse, vbDirectory)
            Do While strTmp <> rep
               strTmp = Dir
            Loop
        End If
        rep = Dir
    Loop
 
    oRst.Close
    oDb.Close
    Set oRst = Nothing
    Set oDb = Nothing
End Sub

A+

[Gabout]

C'était juste le petit plus qui bloquait... je ne l'aurai pas trouvé !

Avec tous mes remerciements

Bien cordialement,