XL 2013 boucle pour traiter chaque fichier d'un même dossier

[jocelcs]

j'aimerai traiter tous les fichiers d'un répertoire un par un pour ensuite rassembler tout les tableaux de variables en un seul
voici le code que j'ai réalisé actuellement pour le traitement d'un seul des fichier du répertoire :

Sub import()

Dim Conn As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim Fichier As String
Dim Chemin As String
Dim rSQL As String
Dim tbl() As Variant
Dim i As Integer
Dim tblLigne As String



Chemin = "C:\"



Fichier = "nomfichier.csv"



'Mise en place de la connexion avec le fichier

Set Conn = New ADODB.Connection
Conn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Chemin & ";Extended Properties=""text;HDR=no;FMT=Delimited(";")"""
Conn.Open

rSQL = "SELECT * FROM [" & Fichier & ".CSV]"
Set Rst = New ADODB.Recordset
Set Rst = Conn.Execute(rSQL)
tbl = Rst.GetRows
For i = 0 To UBound(tbl, 2)



tbl(0, i) = Split(tbl(0, i), ";")

Next
Conn.Close

Loop

End Sub

 

[D.D.]

Bonjour

Essaye avec quelque chose comme ca:

Rep = Ton répertoire de base

Set oFS = CreateObject("Scripting.FileSystemObject")


For Each F1 In oFS.GetFolder(Rep).SubFolders
     For Each F2 In F1.Files
        If Left(F2.Name, 2) = "00" Then 'Par exemple
            'ce que tu veux faire
        End IF
    Next F2
Next F1

 

[jocelcs]

Bonjour

Essaye avec quelque chose comme ca:

Rep = Ton répertoire de base

Set oFS = CreateObject("Scripting.FileSystemObject")


For Each F1 In oFS.GetFolder(Rep).SubFolders
     For Each F2 In F1.Files
        If Left(F2.Name, 2) = "00" Then 'Par exemple
            'ce que tu veux faire
        End IF
    Next F2
Next F1

merci beaucoup de ta réponse, mais je ne comprends pas le raisonnement ..
voici ce que j'ai fait :

Sub tranfertCSV_Vers_NouvelleTableAccess()
'Transfére un fichier CSV vers un tableau
'depuis une macro Excel.
'
'Nécessite d'activer la référence
'"Microsoft ActiveX Data Objects x.x Library
'


Dim Csv_CN As New ADODB.Connection
Dim Csv_Rst As New ADODB.Recordset
Dim dossierCSV As String, NomTable As String
Dim FichCSV As String, MaBase As String
Dim nbEnr As Long
Dim tbl As Variant
Dim F1 As Object, F2 As Object, ofs As Variant





'Répertoire du fichier CSV
dossierCSV = "C:\Users\lucasj\Desktop\Doc\PROJET\mvision\Traitement_donnees_Colryut_Sens\Colryut_Sens"

Set ofs = CreateObject("Scripting.FileSystemObject")

For Each F1 In ofs.GetFolder(dossierCSV).SubFolders


For Each F2 In F1.Files
'Nom du fichier CSV à transfèrer
FichCSV = F1


'Connection au fichier CSV
Csv_CN.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
dossierCSV & ";Extended Properties='text;FMT=Delimited'"
'Requète dans le fichier CSV
Csv_Rst.Open "SELECT * FROM " & FichCSV, Csv_CN, _
adOpenStatic, adLockOptimistic



Csv_CN.Execute "SELECT * From [" & FichCSV & "]", nbEnr

tbl = Csv_Rst.GetRows


For i = 0 To UBound(tbl, 2)


tbl(0, i) = Split(tbl(0, i), ";")

h1 = tbl(0, i)

Worksheets("feuil1").Cells(i + 1, 1).Value = h1

Next


Next F2
Next F1

Csv_Rst.Close
Csv_CN.Close
Set Csv_Rst = Nothing
Set Csv_CN = Nothing
End Sub