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 ?
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
Thierryp
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
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 ?
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
JB
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
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
-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
François Schmit
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" a écrit dans le message de news:
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
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" a écrit dans le message de news:
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