Nom de fichiers de sous fichiers et de documents dans table Access

Version imprimable

Bonjour,

Je me suis aidée d'une précédente discussion pour résoudre une partie de mon problème. Le voici

Je voulais mettre dans une table Access les noms des fichiers se trouvant dans le répertoire C:\devis\. Ces noms de fichiers étant :

- Septembre
- Octobre
- Novembre

Et de plus j'affiche dans cette table les noms des sous fichiers se trouvant dans les fichiers : Septembre, Octobre, Novembre

Voici un exemple de nom de sous fichier dans septembre: ACH, VAUCLIN, GAMADA,....

Maintenant j'aimerais avoir encore un niveau en dessous des sous fichiers, c'est à dire afficher dans la table les dossiers se trouvant dedans.

Par exemple dans ACH, j'ai :

-123.xls
- 456.tif
- 547.pdf

J'aimerai que ces dossiers apparaissent dans la table.

Voila le début de mon code :

--------------------------------------------------------------------------

Code:

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
52
53
54
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 Devis As String
    Dim rep As String, sousrep As String, strTmp As String
    Dim blnNiv2 As Boolean
    Dim blnNiv3 As Boolean
 
    Devis = "M:\Tableaux Excel\Devis\"
 
    rep = Dir(Devis, vbDirectory)
    Do While (rep <> "")
        If rep <> "." And rep <> ".." And _
           (GetAttr(Devis & rep) And vbDirectory) = vbDirectory Then
            blnNiv2 = False
            sousrep = Dir(Devis & rep & "\", vbDirectory)
            Do While (sousrep <> "")
                If sousrep <> "." And sousrep <> ".." And _
                  (GetAttr(Devis & rep & "\" & sousrep) And vbDirectory) = vbDirectory Then
                    blnNiv2 = True
                    oRst.AddNew
                    oRst.Fields("Nom dossier").Value = rep
                    oRst.Fields("Nom fichier").Value = sousrep
                    oRst.Update
 
                End If
                sousrep = Dir
            Loop
            If blnNiv2 = False Then
                oRst.AddNew
                oRst.Fields("Nom fichier").Value = rep
                oRst.Update
            End If
            ' Synchro
            strTmp = Dir(Devis, 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

--------------------------------------------------------------------------
La je n'arrive pas a trouver le code donnant les documents se trouvant dans les sous fichier:cry:

Pouvez vous m'aider??

Voici un exemple de code que j'ai utilisé pour scanner un lecteur de réseau avec tous les sous-répertoires. Il ne recherche que les fichiers dwg. En utilisant les arguments corrects de l'objet FileSearch, tu dois pouvoir inclure aussi les répertoires. voici l'exemple de mon code, un peu épuré :

Code:

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
52
53
54
DoCmd.Echo True, "Vide la table des anciennes données"
'vide la table des data
strSql = "DELETE * FROM tblData"
CurrentDb.Execute strSql
 
DoCmd.Echo True, "Lecture des paramètres d'exécution"
 
'définition du chemin du scan
strSql = "SELECT * FROM tblKeys WHERE Key ='Filer'"
Set rst = CurrentDb.OpenRecordset(strSql)
strBegin = rst.Fields(1) & "\"
rst.Close
 
'définition des exécutions
datBegin = Now()
Set rst = CurrentDb.OpenRecordset("tblExec")
datPrevBegin = rst!LastBegin
 
'déclaration de la table de résultat
Set rst = CurrentDb.OpenRecordset("tblData")
 
Set fs = Application.FileSearch
'parcours le disque à la recherche des fichiers DWG et remplit la table
'DATA avec le nom des fichiers qui sont plus anciens que la dernière exéuction
With fs
    'pour les tests
    '.LookIn = "F:\"
    .LookIn = strBegin
    .SearchSubFolders = True
    'pour les tests
    '.FileName = "*.mdb"
    .FileName = "*.dwg"
    'exécution de la recherche
    If .Execute() > 0 Then
        For l = 1 To .FoundFiles.Count
            'test de présence du fichier dwg
            If Dir(.FoundFiles(l)) <> "" Then
                'comparaison de la date du fichier avec dernier lancement du programme
                'seuls les fichiers postérieurs au dernier lancement sont traités
                If FileDateTime(.FoundFiles(l)) >= datPrevBegin Then
                            'enregistre le nom du fichier
                            rst.AddNew
                            rst.Fields(0) = .FoundFiles(l)
                            rst.Update
                         'fin de comparaison de la date du fichier avec dernier lancement du programme
                End If
            'fin du test de présence du fichier dwg
            End If
        'fin de la boucle dans le résultat de recherche
        Next l
     'fin de la recherche
     End If
End With
rst.Close

20/12/2006, 10h51
Muhad'hib

Merci de suivre le premier post