Tableau et listes de fichiers

Version imprimable

17/07/2009, 11h39
thomas1806

Tableau et listes de fichiers

Bonjour à tous.

Je débute en Vba et cela fait 3 jours que je rames...

je dois indiquer le chemin d'un répertoire dans mon code, et enregistrer tous les fichiers *.sfc de ce répertoire et des sous répertoire et enregistrer le chemin des fichiers dans un tableau.

Si quelqu'un peu m'aider ce serait sympa.

Merci
17/07/2009, 11h50
Krovax
Bonjour,
Tu tape "lister fichier" dans la faq et paf ca te fait non pas des chocapics (faut pas pousser) mais une jolie réponse
http://excel.developpez.com/faq/inde...riptingRuntime

Tu fais juste un teste pour avoir l'extention par exemple
Code:

1 2 3 if right(FileItem.Name,4)=".sfc" then cells(i,1)=FileItem.ParentFolder & "\" & FileItem.Name end if
Si c'est bien ce que tu cherche a faire je n'ai plus qu'à te laisser adapter tout ca, et tu reviens avec ta version du code si ca ne fonctionne pas ;)

Voila mon code. J'ai une erreur avec mon Range et je n'arrive pas a enregistrer le chemin de tous mes fichier .sfc dans mon tableau.

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
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
Option Explicit
Public nb As Integer
Dim Tableau()
 
Sub Appel()
Dim chemin As String
    nb = 0
    chemin = "C:\APT\PROGRAM\LIGNES\UNITS"
    Lister chemin
 
End Sub
Public Function Lister(chemin As String)
Dim fs, Rep As Variant, NewRep As String, Nomfich As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Lister = fs.GetFolder(chemin).Files.Count
    Nomfich = Dir(chemin & "\*.sfc")
    Do While Nomfich <> ""
 
        nb = nb + 1
        Cells(nb, 10) = chemin & "\" & Nomfich 'liste dans la feuille de calculs active
        Nomfich = Dir()
 
    Loop
 
    For Each Rep In fs.GetFolder(chemin).SubFolders
        NewRep = Lister(Rep.Path)
 
    Next Rep
 
    Dim Temp As String, Ligne, Z, Colonne As Integer
 
 
Z = 1
Ligne = 1
Colonne = 1
Temp = Dir("C:\APT\PROGRAM\LIGNES\UNITS\*.", vbDirectory)
Do
ReDim Preserve Tableau(1 To Z)
  If Temp = "" Then
    Exit Do
  ElseIf Temp = "." Or Temp = ".." Then
    'Ne rien afficher
  Else
    Cells(Ligne, Colonne) = Temp
    Ligne = Ligne + 1
    Tableau(Z) = Temp
    Z = Z + 1
  End If
  Temp = Dir
 
Loop
 
Dim DernièreLigneUnits, DernièreLigneFichiers As Variant
Dim i, j, PosSlash, PointeurColFichiers, k, NomFichier As Integer
 
 Range("A1").Select
    DernièreLigneUnits = ActiveCell.End(xlDown).Row
 Range("J1").Select
    DernièreLigneFichiers = ActiveCell.End(xlDown).Row
 
    For i = 1 To DernièreLigneUnits
 
            PointeurColFichiers = 0
 
            For j = 1 To DernièreLigneFichiers
 
                PosSlash = 0
 
                For k = 1 To 6
 
                    PosSlash = InStr(PosSlash + 1, Range("j" & CStr(j)), "\")
 
                Next k
 
 
 
                NomFichier = Left(Range("j" & CStr(j)), PosSlash)
 
                If InStr(1, NomFichier, Range("A" & CStr(i))) <> 0 Then
 
                    Range(Chr(67 + PointeurColFichiers) & CStr(i)) = Range("j" & CStr(j))
 
                    PointeurColFichiers = PointeurColFichiers + 1
 
                End If
 
            Next j
 
    Next i
 
 
 
End Function

Le but étant d'avoir tous les chemin dans une variable, la je fais aussi dans les celulles car cela me parraissait plus facile ;)

Bonjour,
Pour avoir tout les chemins dans un tableau tu peu faire ça en une seule passe...
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Public Function Lister(chemin As String) Dim fs, Rep As Variant, NewRep As String, Nomfich As String ReDim Tableau(0) Set fs = CreateObject("Scripting.FileSystemObject") Lister = fs.GetFolder(chemin).Files.Count Nomfich = Dir(chemin & "\*.sfc") Do While Nomfich <> "" nb = nb + 1 Cells(nb, 10) = chemin & "\" & Nomfich 'liste dans la feuille de calculs active Nomfich = Dir() Loop For Each Rep In fs.GetFolder(chemin).SubFolders ReDim Preserve Tableau(UBound(Tableau) + 1) Tableau(UBound(Tableau)) = Rep NewRep = Lister(Rep.Path) Next Rep ......
La suite j'ai pas trop regarder, remarque quand même... évite les select
Code:

1 2 Range("A1").Select DernièreLigneUnits = ActiveCell.End(xlDown).Row
peu avantageusement être remplacer par

Code:

DernièreLigneUnits = Range("A1").End(xlDown).Row

Mais ce système s'arrète sur la première ligne vide (même si c'est pas la dernière)
Vaut mieux employer

Code:

DernièreLigneUnits = Range("A65536").End(xlUp).Row

A+