reconnaitre une arborescence

Bonjour,

Regarde le fichier joint sur ce lien; ça devrait le faire...peut-être à
adapter

http://cjoint.com/?elvOUj7MhS

@+ thierryp

------------------------
Passer pour un idiot aux yeux d'un imbécile est une volupté de fin
gourmet. (Courteline)
------------------------

Bonjour a tous,
Je souhaiterais construire avec excel un petit "explorer" d'un repertoire de
mon ordinateur (en l'occurence : D:musique ).
Une macro serait chargée de reconnaitre tous les sous-repertoires et les
fichiers presents (ainsi que leurs details : date de creation,taille,etc...)
et de les presenter dans un feuille excel.
Savez vous si qqun a deja construit une telle macro ? Sinon, a l'aide de
quelles instructions pourrais je reussir a realiser cette macro ?

D'avance merci pour vos reponses !

Francois

Bonsoir,

http://cjoint.com/?elvPjawmFk

-Donne la liste des sous-répertoires et des fichiers d'un répertoire.
-Le dossier se choisit dans une boîte de dialogue à partir de
Excel2002. Pour les versions antérieures, utiliser une API.

Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").Clear
Range("a3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine, 1
Range("A1").Select
End Sub

Sub Lit_dossier(ByRef dossier, ByVal niveau)
ActiveCell.Value = decal(niveau - 1) & dossier.Name & "[" &
dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
Lit_dossier d, niveau + 1
Next
For Each f In dossier.Files
nom_fich = f.Name
' ActiveCell.Value = decal(niveau) & f.Name & "* " & f.Size & " : "
& f.DateLastModified
ActiveCell = decal(niveau) & f.Name
ActiveCell.Offset(0, 1) = f.Size
ActiveCell.Offset(0, 2) = f.DateLastModified
ActiveCell.Interior.ColorIndex = 2
ActiveCell.Offset(1, 0).Select
Next
End Sub

Function decal(niv)
decal = String(3 * niv, " ")
End Function

Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function

Cordialement JB

Merci beaucoup !
A croire que la macro a été programmée pour moi !

- Y aurait il moyen de modifier le nom des fichiers directement depuis excel
?
- Y aurait il moyen d afficher egalement les balises de ces fichiers ?
- et Enfin, comment inclure un lien permettant de lancer le fichier avec le
prgm par defaut ?

d'avance merci
Francois



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1144784560.878291.89960@e56g2000cwe.googlegroups.com...
Bonsoir,

http://cjoint.com/?elvPjawmFk

-Donne la liste des sous-répertoires et des fichiers d'un répertoire.
-Le dossier se choisit dans une boîte de dialogue à partir de Excel2002.
Pour les versions antérieures, utiliser une API.

Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").Clear
Range("a3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine, 1
Range("A1").Select
End Sub

Sub Lit_dossier(ByRef dossier, ByVal niveau)
ActiveCell.Value = decal(niveau - 1) & dossier.Name & "[" &
dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
Lit_dossier d, niveau + 1
Next
For Each f In dossier.Files
nom_fich = f.Name
' ActiveCell.Value = decal(niveau) & f.Name & "* " & f.Size & " : "
& f.DateLastModified
ActiveCell = decal(niveau) & f.Name
ActiveCell.Offset(0, 1) = f.Size
ActiveCell.Offset(0, 2) = f.DateLastModified
ActiveCell.Interior.ColorIndex = 2
ActiveCell.Offset(1, 0).Select
Next
End Sub

Function decal(niv)
decal = String(3 * niv, " ")
End Function

Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function

Cordialement JB

Bonjour,


http://cjoint.com/?emitkPnrkc

http://www.excelabo.net/moteurs/compteclic.php?nom=jb-nettoiearborescence

Cordialement JB