Discussion :

[FewRa]

Bonjour à tous

J'essaye d'écrire un code pour pouvoir récuper le nom de fichier word dans des sous-dossier. Quand je teste mon code je sais que dans le dossier il y a 3 sous-dossier et dans chacun d'eux il y a des fichiers word.
le probleme c'est que mon code s'arrete après avoir traiter le premier sous-dossier.

Quelqu'un peut il voir pourquoi le "Loop" de "rep" s'arrête?

Voici le 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
44
45
46
47
48
49
50
Private Sub Extration_click()
Dim Rs As Recordset
 
Dim strFile As String
Dim rep As String
 
 If IsNull(Me.CHEMIN_FICHIER) Then
    MsgBox "Veuillez choisir un dossier"
    Else
    CurrentDb.Execute "Delete * From DOCUMENT", dbFailOnError
 
rep = Dir(Me.CHEMIN_FICHIER, vbDirectory) ' récupére les noms des sous-dossiers
 
 
Do While (rep <> "")
 
    If (GetAttr(Me.CHEMIN_FICHIER & "\" & rep) And vbDirectory) = vbDirectory Then
        If (rep) <> "." And (rep) <> ".." Then
 
   Set Rs = CurrentDb.OpenRecordset("DOCUMENT", dbOpenDynaset)
   strFile = Dir(Me.CHEMIN_FICHIER & "\" & rep & "\*.doc", vbNormal) 'chercher les fichiers dans les dossiers
 
   Do
 
      If strFile = "" Then
        GoTo ExitHere
      End If
 
      Rs.AddNew
      Rs!chemin = strFile
      Rs.Update
 
      strFile = Dir()
   Loop
 
 
        End If
    End If
 
   rep = Dir()
 
Loop
 
 
ExitHere:
   Set Rs = Nothing
   MsgBox ("La mise à jour a été faite")
 
 End If
End Sub

Merci d'avance



EDit: Le problème vient de cette partie:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
If strFile = "" Then
        GoTo ExitHere
      End If

Mais je sais pas comment faire

[marot_r]

Bonjour.

C'est un problème avec Dir() qui n'est pas récursive. Quand tu demandes un nouveau dir(critere) cela efface l'ancien.

Tu peux faire cela de deux façons, soit en gérant à la main la récusivité en gardant une liste des sous répertoires trouvés par Dir() (ex : dans une collection) et en demandant un dir() sur ces sous-répertoires spécifiquement après en avoir fini avec le répertoire courant,

Soit en utilisant un objet FileSystemObject qui permet la récursivité.

Désolé je ne m'en suis jamais vraiment servi donc je n'ai pas plus de détail mais une recherche sur Google devrait te permettre de trouver.

A+

[FewRa]

MErci pour ton aide.
J'ai résolue le problème en les séparents en deux , j'enregistre les noms des dossiers dans une table dans un premier temps et après je vais les chercher pour la deuxième loop.

Voici le 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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Private Sub Extration_click()
Dim Rs As Recordset
Dim Rs1 As Recordset
Dim Rs2 As DAO.Recordset
Dim strFile As String
Dim rep As String
Dim fo As DAO.Field
 
 If IsNull(Me.CHEMIN_FICHIER) Then
    MsgBox "Veuillez choisir un dossier"
    Else
    CurrentDb.Execute "Delete * From Dossier", dbFailOnError
 
rep = Dir(Me.CHEMIN_FICHIER, vbDirectory)
 
Do
    If (GetAttr(Me.CHEMIN_FICHIER & "\" & rep) And vbDirectory) = vbDirectory Then
        If (rep) <> "." And (rep) <> ".." Then
            Set Rs1 = CurrentDb.OpenRecordset("dossier", dbOpenDynaset)
 
 
            Rs1.AddNew
            Rs1!nonfichier = rep
            Rs1.Update
 
        End If
    End If
rep = Dir()
 
 
Loop Until (rep) = ""
Set Rs1 = Nothing
 
 
CurrentDb.Execute "Delete * From DOCUMENT", dbFailOnError
 
Set Rs = CurrentDb.OpenRecordset("DOCUMENT", dbOpenDynaset)
 
Set Rs2 = CurrentDb.OpenRecordset("SELECT nonfichier from dossier")
    If Rs2.RecordCount > 0 Then
    Rs2.MoveFirst
Do Until Rs2.EOF
    For Each f0 In Rs2.Fields
    strFile = Dir(Me.CHEMIN_FICHIER & f0 & "\*.doc", vbNormal)
 
    Do While (strFile <> "")
 
 
      Rs.AddNew
      Rs!chemin = strFile
      Rs.Update
 
 
 
      strFile = Dir()
    Loop
Next
Rs2.MoveNext
Loop
Set Rs = Nothing
Set Rs2 = Nothing
MsgBox ("La mise à jour a été faite")
 
Else
MsgBox "Auccun Dossier n'a été trouvé"
Set Rs = Nothing
Set Rs2 = Nothing
 
 End If
Me.DOCS.Requery
Me.DOCS.Form.Filter = ""
Me.DOCS.Form.FilterOn = True
 End If
End Sub