kiki29 | VBA Excel : Liste des noms de fichiers présents dans un Dossier
La recherche peut être récursive,à adapter au contexte
Dans VBE [Alt+F11] Outils | Références : Cocher Microsoft Scripting Runtime
Option Explicit
Const DossierRacine As String = "C:\Faq\FaqVba\Exemples\ListeFichiers"
Const TypeFichier As String = "xls"
Dim r As Long,c As Long
Dim cpt As Long
Sub Liste()
ShImport.Cells.Clear
r = 1: c = 1: cpt = 0
ListeFichiersDansDossier DossierRacine, False
End Sub
Private Sub ListeFichiersDansDossier(ByVal NomDossierSource As String, ByVal InclureSousDossiers As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder, SousDossier As Scripting.Folder
Dim Fichier As Scripting.File
Set FSO = New Scripting.FileSystemObject
Set DossierSource = FSO.GetFolder(NomDossierSource)
For Each Fichier In DossierSource.Files
If UCase(FSO.GetExtensionName(Fichier.Name)) = UCase(TypeFichier) And Fichier.Name <> ThisWorkbook.Name Then
With ShImport
.Cells(r, c) = Fichier.Name
.Cells(r, c + 1) = Fichier.ParentFolder
End With
cpt = cpt + 1
r = r + 1
Application.StatusBar = "Lecture noms : " & cpt
End If
Next Fichier
If InclureSousDossiers Then
For Each SousDossier In DossierSource.SubFolders
ListeFichiersDansDossier SousDossier.Path, True
Next SousDossier
Set SousDossier = Nothing
End If
Set Fichier = Nothing
Set DossierSource = Nothing
Set FSO = Nothing
End Sub
|
Faire un Split du nom de fichier avec "_" comme séparateur
dans le tableau résultant nommé par exemple Ar en Ar(1) tu auras le nom du dossier voulu
par exemple pour AA009_P002b_Img001 en faisant Ar=Split(NomDuFichier,"_" ) Ar(1) contiendra P002b
Ce qui devrait donner
Private Sub ListeFichiersDansDossier(ByVal NomDossierSource As String, ByVal InclureSousDossiers As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder, SousDossier As Scripting.Folder
Dim Fichier As Scripting.File
Dim Ar() As String
Set FSO = New Scripting.FileSystemObject
Set DossierSource = FSO.GetFolder(NomDossierSource)
For Each Fichier In DossierSource.Files
If UCase(FSO.GetExtensionName(Fichier.Name)) = UCase(TypeFichier) And Fichier.Name <> ThisWorkbook.Name Then
With ShImport
.Cells(r, c) = Fichier.Name
.Cells(r, c + 1) = Fichier.ParentFolder
If InStr(Fichier.Name, "_" ) > 0 Then
Ar = Split(Fichier.Name, "_" )
.Cells(r, c + 2) = Ar(1)
End If
End With
cpt = cpt + 1
r = r + 1
Application.StatusBar = "Lecture noms : " & cpt
End If
Next Fichier
If InclureSousDossiers Then
For Each SousDossier In DossierSource.SubFolders
ListeFichiersDansDossier SousDossier.Path, True
Next SousDossier
Set SousDossier = Nothing
End If
Set Fichier = Nothing
Set DossierSource = Nothing
Set FSO = Nothing
End Sub
|
Message édité par kiki29 le 17-09-2007 à 11:33:33
|