Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel liste fichiers dans sous repertoires

liste fichiers dans sous repertoires

2 réponses
Avatar
Olivier
Bonjour,
J'essaye depuis quelques temps de me simplifier la vie.
Voilà :
J'ai un appareil photos qui me charge les photos dans le dossier C:\photos
avec des sous dossiers ayant comme nom la date de prise de vue.
Dans chaque sous dossiers quelques photos.
Pour faire développer les photos, je transfère manuellement des photos sur
clé USB. J'ai décidé de le faire faire à Excel :
Je pense avoir tout résolu à part le début.
Je voudrais une macro qui me liste toutes les photos contenus dans le
dossier c:\photos et qui inscrive dans les cellules Cells(n°,1) le nom de la
photo avec son chemin d'accès. (L'idée est qu'après j'écrive à côté la
quantité de photos voulues et qu'une autre macro me copie les fichiers sur
ma clé : ça je sais).
J'ai fureté un peu partout pour voir si quelqu'un avait fait une recherche
de fichier dans des sous dossiers mais je n'ai rien trouvé pour les sous
dossiers.
J'ai trouvé pour lister les fichiers d'un répertoire mais pas pour les
sous-répertoires.
Si quelqu'un peut m'aider.
Merci
Olivier1970
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
AH60
Bonjour

voila ce que j'ai trouver pour toi...!
là >>> http://frederic.sigonneau.free.fr/

' Liste les fichiers d'un dossier et de ses sous dossiers
' dans une feuille de calcul avec certains renseignements
' d'après Ole P Erlandsen
' code original à cette adresse http://www.erlandsendata.no/)

Sub TestListFilesInFolder()
Dim RootFolder$

' dossier à scanner
RootFolder = ChoisirDossier
If RootFolder = "" Then Exit Sub

' create a new workbook for the file list
Workbooks.Add

' add headers
With Range("A1")
.Formula = " Contenu du dossier : " & RootFolder
.Font.Bold = True
.Font.Size = 12
End With

Range("A3").Formula = "Chemin : "
Range("B3").Formula = "Nom : "
Range("C3").Formula = "Date Création : "
Range("D3").Formula = "Date Dernier Accès : "
Range("E3").Formula = "Date Dernière Modif : "

With Range("A3:E3")
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With

' list all files included subfolders
ListFilesInFolder RootFolder, True

Columns("A:H").AutoFit

End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As
Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:FolderName", True
' Ole P Erlandsen (modifié fs 11/8/01)

Dim FSO 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim SubFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim r As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1

For Each FileItem In SourceFolder.Files
' display file properties
Cells(r, 1).Formula = FileItem.ParentFolder
Cells(r, 2).Formula = FileItem.Name
Cells(r, 3).Formula = FileItem.DateCreated
Cells(r, 3).NumberFormatLocal = "jj/mm/aa"
Cells(r, 4).Formula = FileItem.DateLastAccessed
Cells(r, 5).Formula = FileItem.DateLastModified
Cells(r, 5).NumberFormatLocal = "jj/mm/aa"
' next row number
r = r + 1
Next FileItem

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

ActiveWorkbook.Saved = True

End Sub

Private Function ChoisirDossier()
Dim objShell, objFolder, chemin, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
On Error Resume Next
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoisirDossier = chemin
End Function


Cordialement Abed_H






Bonjour,
J'essaye depuis quelques temps de me simplifier la vie.
Voilà :
J'ai un appareil photos qui me charge les photos dans le dossier C:photos
avec des sous dossiers ayant comme nom la date de prise de vue.
Dans chaque sous dossiers quelques photos.
Pour faire développer les photos, je transfère manuellement des photos sur
clé USB. J'ai décidé de le faire faire à Excel :
Je pense avoir tout résolu à part le début.
Je voudrais une macro qui me liste toutes les photos contenus dans le
dossier c:photos et qui inscrive dans les cellules Cells(n°,1) le nom de la
photo avec son chemin d'accès. (L'idée est qu'après j'écrive à côté la
quantité de photos voulues et qu'une autre macro me copie les fichiers sur
ma clé : ça je sais).
J'ai fureté un peu partout pour voir si quelqu'un avait fait une recherche
de fichier dans des sous dossiers mais je n'ai rien trouvé pour les sous
dossiers.
J'ai trouvé pour lister les fichiers d'un répertoire mais pas pour les
sous-répertoires.
Si quelqu'un peut m'aider.
Merci
Olivier1970





Avatar
Olivier
Merci, c'est exactement ce qu'il me fallait.
Je n'avais pas réussi à trouver ce code...

Olivier1970



"AH60" a écrit dans le message de news:

Bonjour

voila ce que j'ai trouver pour toi...!
là >>> http://frederic.sigonneau.free.fr/

' Liste les fichiers d'un dossier et de ses sous dossiers
' dans une feuille de calcul avec certains renseignements
' d'après Ole P Erlandsen
' code original à cette adresse http://www.erlandsendata.no/)

Sub TestListFilesInFolder()
Dim RootFolder$

' dossier à scanner
RootFolder = ChoisirDossier
If RootFolder = "" Then Exit Sub

' create a new workbook for the file list
Workbooks.Add

' add headers
With Range("A1")
.Formula = " Contenu du dossier : " & RootFolder
.Font.Bold = True
.Font.Size = 12
End With

Range("A3").Formula = "Chemin : "
Range("B3").Formula = "Nom : "
Range("C3").Formula = "Date Création : "
Range("D3").Formula = "Date Dernier Accès : "
Range("E3").Formula = "Date Dernière Modif : "

With Range("A3:E3")
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With

' list all files included subfolders
ListFilesInFolder RootFolder, True

Columns("A:H").AutoFit

End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As
Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:FolderName", True
' Ole P Erlandsen (modifié fs 11/8/01)

Dim FSO 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim SubFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim r As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1

For Each FileItem In SourceFolder.Files
' display file properties
Cells(r, 1).Formula = FileItem.ParentFolder
Cells(r, 2).Formula = FileItem.Name
Cells(r, 3).Formula = FileItem.DateCreated
Cells(r, 3).NumberFormatLocal = "jj/mm/aa"
Cells(r, 4).Formula = FileItem.DateLastAccessed
Cells(r, 5).Formula = FileItem.DateLastModified
Cells(r, 5).NumberFormatLocal = "jj/mm/aa"
' next row number
r = r + 1
Next FileItem

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

ActiveWorkbook.Saved = True

End Sub

Private Function ChoisirDossier()
Dim objShell, objFolder, chemin, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
On Error Resume Next
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoisirDossier = chemin
End Function


Cordialement Abed_H






Bonjour,
J'essaye depuis quelques temps de me simplifier la vie.
Voilà :
J'ai un appareil photos qui me charge les photos dans le dossier
C:photos
avec des sous dossiers ayant comme nom la date de prise de vue.
Dans chaque sous dossiers quelques photos.
Pour faire développer les photos, je transfère manuellement des photos
sur
clé USB. J'ai décidé de le faire faire à Excel :
Je pense avoir tout résolu à part le début.
Je voudrais une macro qui me liste toutes les photos contenus dans le
dossier c:photos et qui inscrive dans les cellules Cells(n°,1) le nom de
la
photo avec son chemin d'accès. (L'idée est qu'après j'écrive à côté la
quantité de photos voulues et qu'une autre macro me copie les fichiers
sur
ma clé : ça je sais).
J'ai fureté un peu partout pour voir si quelqu'un avait fait une
recherche
de fichier dans des sous dossiers mais je n'ai rien trouvé pour les sous
dossiers.
J'ai trouvé pour lister les fichiers d'un répertoire mais pas pour les
sous-répertoires.
Si quelqu'un peut m'aider.
Merci
Olivier1970