Lister automatiquement des feuilles Excel

[Riri]

Bonsoir le Forum,

Je voudrais savoir si il est possible de lister automatiquement via un code VBA tous les fichiers contenus dans un dossier.
Je voudrais les lister dans une feuille Excel.

Merci d’avance pour vos réponses …….Riri

 

[chris]

Bonjour
En utilisant la commande Dir "*.xls"
dans une boucle qui écrit chaque nom trouvé tu peux l'obtenir.
Chris

 

[michel]

bonjour Riri , bonjour Chris

pour completer la reponse de Chris , ci joint un exemple

Sub RecupererListeFichiersDansRepertoire()
Dim X As Integer, nbFichiers As Integer
Dim Tableau() As String
Dim Direction As String

Direction = Dir("C:\reperetoire\*.xls") 'adapter chemin
'Direction = Dir("C:\repertoire\*.*") 'pour recuperer tous les types de fichiers

Do While Len(Direction) > 0
nbFichiers = nbFichiers + 1
ReDim Preserve Tableau(1 To nbFichiers)
Tableau(nbFichiers) = Direction
Direction = Dir()
Loop

If nbFichiers > 0 Then

MsgBox "il y a " & nbFichiers & " fichiers dans le repertoire . "
'pour afficher tous les noms de fichiers
For X = 1 To nbFichiers
Cells(X, 1) = Tableau(X)
Next X
End If

End Sub


bonne soiree
michel

 

[Riri]

Bonsoir chris et michel

Merci pour votre aide je vais mettre en pratique ce code

Bonne soirée à vous et @ + .........Riri

 

[deguste]

j'aurais une question à propos de ce post...

c'est vraiment sympa cette macro mais serait-il possible quand on à la liste des fichiers dans la table excel d'avoir dans la colonne b les valeurs de la cellule A1 de la feuille1 de chaque fichier excel ???????? et d'autres cellules aussi ?

 

[michel]

bonsoir Deguste

la macro ci dessous liste tous les classseurs d'un repertoire dans la colonne A
dans la colonne B sont insérés les valeurs de la cellule A1 , de chaque classeur

Option Explicit
Dim X As Integer
Sub RecupererListeFichiersDansRepertoire()
Dim nbFichiers As Integer
Dim Tableau() As String, Cible As String , Valeur As String
Dim Direction As String

Direction = Dir("C:\Repertoire\*.xls") 'adapter chemin

Do While Len(Direction) > 0
nbFichiers = nbFichiers + 1
ReDim Preserve Tableau(1 To nbFichiers)
Tableau(nbFichiers) = Direction
Direction = Dir()
Loop

If nbFichiers > 0 Then

MsgBox "il y a " & nbFichiers & " fichiers dans le repertoire . "
'pour afficher tous les noms de fichiers
For X = 1 To nbFichiers
Cells(X, 1) = Tableau(X)

Valeur = "C:\Repertoire\" & Tableau(X)
Cible = Cells(1, 1).Address(0, 0) & ":" & Cells(1, 1).Address(0, 0) 'plage des valeurs à recuperer
VaChercherMonLycos Valeur, Cible
'adapter chemin du fichier contenant les valeurs à recuperer

Next X
End If
End Sub

Public Sub VaChercherMonLycos(Fichier As String, Plage As String)
Dim dbConnection As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim dbConnectionString As String

dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;" & "DBQ=" & Fichier
Set dbConnection = New ADODB.Connection

dbConnection.Open dbConnectionString

Set Rs = dbConnection.Execute("[" & Plage & "]")
Range("B" & X) = Rs.Fields(0).Name
Range("B" & X).CopyFromRecordset Rs

Rs.Close
dbConnection.Close
Set Rs = Nothing
Set dbConnection = Nothing
End Sub

necessite d'activer les references
Visual Basic For Applications
Microsoft Excel xx Object Library
OLE Automation
Microsoft Office xx Object Library
Microsoft ActiveX Data Objects 2.7 Library
Microsoft Forms 2.0 Object Library


bonne soiree
michel

 

[deguste]

merci mon ami Michel

vraiment très sympa..

je vais enfin pouvoir avancer dans mes travaux :-D