Discussion :

[GV.zero]

Bonjour,

Je suis débutant en VB. Je veux créér une macro qui affiche le chemin absolu du fichier le plus récent.
En parcourant tous les sous-dossiers.
Bref tout ça fonctionne après des heures de recherche ...

Le problème c'est que je suis obligé de mettre le nom du fichier exact exemple aaaa.txt
C'est un problème pour moi car j'aimerai mettre partiellement le nom du fichier exemple *aa*.txt

Je pense que c'est cette méthode qui est en cause :

Set oFl = p_oFld.Files(p_strFichier & ".txt")

J'aimerai une solution qui me permette de ne pas réécrire tout le code ...

Pouvez-vous m'aider à corriger ce soucis ?


Merci beaucoup

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
Dim tableau() As File 
 
Dim cpt As Integer 
 
 
 
 
 
Sub rezerze() 
 
 
 
    cpt = 0 
 
    Explorer "aaaaaa", "C:\TestGui" 
 
 
 
    Dim i As Integer 
 
    Dim monFichierSqlPath As String 
 
    Dim monFichierSqlDate As String 
 
 
 
    monFichierSqlDate = tableau(0).DateLastModified 
 
    monFichierSqlPath = tableau(0).Path 
 
 
 
 
 
    For i = 0 To cpt - 1 
 
        If monFichierSqlDate < tableau(i).DateLastModified Then ' => SI condition validée ALORS 
 
            monFichierSqlPath = tableau(i).Path 
 
            monFichierSqlDate = tableau(i).DateLastModified 
 
        Else ' => SINON 
 
           'Instructions si faux 
 
        End If 
 
                'MsgBox tableau(i).Path 
 
    Next 
 
    MsgBox monFichierSqlPath 
 
 
 
End Sub 
 
 
 
Sub Explorer(p_strFichier As String, p_strCheminDepart As String, Optional p_oFld As Scripting.Folder) 
 
On Error GoTo err 
 
 
 
    Dim oFSO As Scripting.FileSystemObject 
 
    Dim oFld As Scripting.Folder 
 
    Dim oFl As File 
 
    Dim fichierdir As String 
 
 
 
    If p_oFld Is Nothing Then 
 
        'Instanciation du FSO 
 
        Set oFSO = New Scripting.FileSystemObject 
 
        'Accède au répertoire du départ de recherche 
 
        'fichierdir = Dir(p_strCheminDepart & "\" & p_strFichier) 
 
        Set p_oFld = oFSO.GetFolder(p_strCheminDepart) 
 
 
 
    End If 
 
    'fichierdir = Dir(p_strCheminDepart & "\" & p_strFichier) 
 
    Set oFl = p_oFld.Files(p_strFichier & ".txt") 'probleme ici je ne peux pas mettre aa*.txt
 
 
 
    cpt = cpt + 1 
 
    ReDim Preserve tableau(cpt) 
 
    Set tableau(cpt - 1) = oFl 
 
    'MsgBox oFl.Path 
 
    'MsgBox tableau(cpt).Path 
 
 
 
SubDir: 
 
'Explore les sous-dossiers 
 
    For Each oFld In p_oFld.SubFolders 
 
        Explorer p_strFichier, p_strCheminDepart, oFld 
 
        DoEvents 
 
    Next oFld 
 
 
 
fin: 
 
    Exit Sub 
 
err: 
 
    Select Case err.Number 
 
        Case 53: Resume SubDir 
 
        Case Else: 
 
            MsgBox "Erreur inconnue" 
 
            Resume fin 
 
    End Select 
 
 
 
End Sub

[clementmarcotte]

Bonjour,

C'est un exemple VBScript pour utiliser la recherche de Windows. Cela doit être adapté en VBA. Par contre, cela ne fonctionne (vraiment) pas (vraiment) pour les dossiers non indexés. Mais, si le fichier est indexé, c'est la méthode la plus rapide

Par expérience, en VB6-VBA, toute autre méthode que la recherche de Windows, a beaucoup de difficultés avec les noms de fichiers incomplets. Une autre excellente raison de passer à VB.net. Le Framework .net s'en tire mieux à cet égard. Même si cela risque d'être long longtemps.

[kiki29]

Salut, à voir et adapter : Liste des fichiers d'un dossier

[Qwazerty]

SAlut

Pour répondre à ta question, quand tu fais

Code :

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

Set oFl = p_oFld.Files("Blaba.txt")

Tu pointes sur une collection de fichier (Files) un fichier unique qui se nomme Blabla.txt

Si maintenant tu écris (en admettant que l'on puisse utiliser *, ce qui n'est pas le cas

Code :

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

Set oFl = p_oFld.Files("Blaba*.txt")

Ici plusieurs fichiers pourraient correspondre et Files ne saurait pas lequel te retourner. Tu n'as pas le choix, il faut que tu fasse une boucle sur le contenu de files pour extraire ce dont tu as besoin. Un truc comme ça:

Dim oneFile As Scripting.File

Code :

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

1
2
3
4
5
6
 
For each oneFile in p_oFld.Files
   If oneFile.name like "p_strFichier & ".txt"" then
       'Tu réalises ici ce que tu as besoin de faire
       if onefile.DateLastModified = ... then
...

(Je pense inutile de dire que je n'ai pas testé le code ^^)

++
Qwaz

[Theze]

Bonjour,

Une piste avec FSO. Le chemin, le nom et la date de dernière modif du fichier sont inscrit dans les colonnes A, B et C de la feuille active :

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
 
Dim Fso As Object
Dim Dos As Object
Dim D As Object
Dim F As Object
Dim Fichier As String
 
Sub RecupDonnees()
 
    Dim Tbl() As String
    Dim I As Integer
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
 
    'le chemin du dossier "racine" est le chemin du classeur où se trouve ce code-ci, adapter
    RecupFichiers ThisWorkbook.Path, Tbl
 
    If Not Not Tbl() Then
 
        For I = 1 To UBound(Tbl, 2)
 
            Cells(I, 1).Value = Tbl(1, I)
            Cells(I, 2).Value = Tbl(2, I)
            Cells(I, 3).Value = Tbl(3, I)
 
        Next I
 
    End If
 
End Sub
 
Sub RecupFichiers(Dossier As String, Tbl() As String)
 
    If Right(Dossier, 1) <> "\" Then Dossier = Dossier & "\"
 
    If Fso.FolderExists(Dossier) = False Then Exit Sub
 
    Set Dos = Fso.getfolder(Dossier)
 
    'boucle sur les sous-dossiers
    For Each D In Dos.subfolders
 
        Fichier = Dir(D.Path & "\" & "*.txt")
 
        Do While (Len(Fichier) > 0)
 
            On Error Resume Next 'évite l'erreur du tableau non initialisé
            ReDim Preserve Tbl(1 To 3, 1 To UBound(Tbl, 2) + 1)
            If err.Number <> 0 Then ReDim Tbl(1 To 3, 1 To 1)
            On Error GoTo 0
 
            Set F = Fso.GetFile(D.Path & "\" & Fichier)
 
            Tbl(1, UBound(Tbl, 2)) = D.Path & "\"
            Tbl(2, UBound(Tbl, 2)) = Fichier
            Tbl(3, UBound(Tbl, 2)) = F.DateLastModified
 
            Fichier = Dir()
 
        Loop
 
        RecupFichiers D.Path, Tbl()
 
    Next D
 
End Sub