Listar Carpetas y Archivos

Hola.

El siguiente código muestra lo que tu quieres.

Fue elaborado por Frederic Sigonneau, del cuál te adjunto página web y link

http://frederic.sigonneau.free.fr

Verás que tiene bastante código bueno

El link correspondiente a la información de archivos:


http://frederic.sigonneau.free.fr/c...chiers.txt

El código te lo engancho igualmente a continuación:

Attribute VB_Name = "ListeProprietesFichiers"

'Ce module comprend :
' - une procédure qui examine de façon récursive un dossier et tous
' ses sous-dossiers et remplit un tableau avec quelques-unes des propriétés
' des fichiers qu'ils contiennent
' - une procédure exemple qui utilise la procédure précédente pour renvoyer
' les éléments du tableau dans une feuille de calcul.
'La progression du travail apparaît dans la barre d'état

Sub TousLesFichiers(LeDossier$, Idx As Long, OutArr)
'remplit un tableau avec 8 des propriétés de fichier accessibles
'par le FileSystemObject
Dim fso As Object, Dossier As Object
Dim sousRep As Object, fich As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(LeDossier)

'examen du dossier courant
For Each fich In Dossier.Files
Idx = Idx + 1
ReDim Preserve OutArr(1 To 8, 1 To Idx)
'supprimer cette ligne si le travail de la macro doit rester caché
Application.StatusBar = " Lecture : " & fich.Path
On Error Resume Next
OutArr(1, Idx) = fich.ParentFolder
OutArr(2, Idx) = fich.Name
OutArr(3, Idx) = fich.DateCreated
OutArr(4, Idx) = fich.DateLastModified
OutArr(5, Idx) = fich.ShortPath
OutArr(6, Idx) = fich.ShortName
OutArr(7, Idx) = fich.Size
OutArr(8, Idx) = fich.Type
On Error GoTo 0
Next

'traitement récursif des sous dossiers
For Each sousRep In Dossier.SubFolders
TousLesFichiers sousRep.Path, Idx, OutArr
Next sousRep

Set fso = Nothing
Application.StatusBar = False

End Sub 'fs

'exemple d'utilisation :
'renvoi de la liste des propriétés dans une feuille de calcul
'pour tous les fichiers du lecteur D
Sub TestFichiers()
Dim ArrFich(), entetes(), i&, j&

Application.ScreenUpdating = False

TousLesFichiers "D:\", 0, ArrFich

Sheets.Add
'ligne d'entêtes
entetes = Array("", "Chemin", "Nom", "Date création", _
"Date modification", "Chemin court", "Nom court", "Taille", "Type")
For i = 1 To 8
Cells(1, i).Value = entetes(i)
Next
With Range("A1:H1")
.Font.Bold = True
.Interior.ColorIndex = 35
.HorizontalAlignment = xlHAlignCenter
End With

'renvoi des données du tableau
For j = LBound(ArrFich, 1) To UBound(ArrFich, 1)
For i = LBound(ArrFich, 2) To UBound(ArrFich, 2)
Application.StatusBar = " Écriture : " & ArrFich(1, i) & "\" &
ArrFich(2, i)
Cells(i + 1, j).Value = ArrFich(j, i)
Next i
Next j

'mise en forme et tri
Columns("A:H").AutoFit
Range("A2:H" & i).Sort Range("A2"), , Range("B2")
Application.StatusBar = False
MsgBox "Nb de fichiers examinés : " & UBound(ArrFich, 2)

End Sub 'fs


Saludos.

Benito Merino

"Luis Rentería" wrote:

Buenos días(tardes)!

¿Qué código debería agregarse para que la macro agregue también los archivos
o ficheros dentro de cada carpeta?

Saludos.

lrenteria arroba hotmail punto com
"Aprendiz" wrote in message
news:
> Gracias Benito, funciona perfectamente.
> Saludos
> José Rafael
>
> "Benito Merino" <Benito escribió en el
> mensaje news:
> > Hola.
> >
> > La siguiente macro te realiza lo que indicas.
> >
> > Sub Infodirectorios()
> >
> > Dim FSO As Object
> > Dim TopFolderName As String
> > Dim TopFolder As Object
> > Dim Fldr As Object
> > Dim Rng As Range
> >
> >
> > TopFolderName = "C:\" 'indicar directorio
> > Set FSO = CreateObject("Scripting.FileSystemObject")
> > Set TopFolder = FSO.GetFolder(TopFolderName)
> > Set Rng = Range("A1")
> > For Each Fldr In TopFolder.SubFolders
> > Rng(1, 1).Value = Fldr.Path ' directorio
> > Rng(1, 2).Value = Fldr.Size 'tamaño
> > Rng(1, 3).Value = Fldr.Datecreated 'fecha creación
> > Rng(1, 4).Value = Fldr.DateLastModified 'fecha última
modificación
> > Set Rng = Rng(2, 1) 'siguiente fila
> > Next Fldr
> >
> > End Sub
> >
> > Información adicional de este objeto la puedes encontrar en el siguiente
> link:
> >
> >
>
http://msdn.microsoft.com/library/d...cessed.asp
> >
> >
> > Saludos,
> >
> > Benito Merino
> > Barcelona
> >
> >
> > "Aprendiz" wrote:
> >
> > > ¿Alguien conoce la manera de tener en una hoja Excel un listado de las
> > > carpetas de determinado directorio, p.e. Mis documentos y que indique
el
> > > tamaño y fecha de la última modificación?
> > > Gracias anticipadas
> > >
> > >
> > >
>
>



lrenteria arroba hotmail punto com