OVH Cloud OVH Cloud

importer liste de dossier/fichier

6 réponses
Avatar
marc
Bonjour,

Je souhaite creer une liste des mes albums mp3, peut on directement importer
un dossier et ses sous dossiers de l'explorateur windows dans excel?

merci

6 réponses

Avatar
papou
Bonjour
Il me semble que tu dois pouvoir trouver un bon nombre d'exemples chez
Frédéric ici :
http://perso.wanadoo.fr/frederic.sigonneau/Fichiers.htm

Cordialement
Pascal

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

Bonjour,

Je souhaite creer une liste des mes albums mp3, peut on directement
importer
un dossier et ses sous dossiers de l'explorateur windows dans excel?

merci


Avatar
isabelle
bonjour Marc,

oui c'est possible il y a plusieurs version de macro qui font la chose.
moi j'utilise toujours celle ci :

Sub ListeTousLesFichiersDunDossier()
Dim fso As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, I As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
Répertoire = "c:zaza" 'Modifie le répertoire
If Répertoire = "" Then Exit Sub
Set Dossier = fso.getfolder(Répertoire)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each File In Files
Fichier = File.Name
x = x + 1
Range("A" & x) = Fichier
Next
End If
End Sub


isabelle


Bonjour,

Je souhaite creer une liste des mes albums mp3, peut on directement importer
un dossier et ses sous dossiers de l'explorateur windows dans excel?

merci


Avatar
isabelle
et également celle ci qui permet de choisir le type de fichier:

Sub TousLesFichiersDunDossier2()
Set fs = Application.FileSearch
With fs
.LookIn = "C:zaza"
.Filename = "*.xls"
.Execute
For I = 1 To .FoundFiles.Count
x = x + 1
Range("A" & x) = .FoundFiles(I)
Next I
If .FoundFiles.Count = 0 Then
MsgBox "Aucun fichier n'a été trouvé."
End If
End With
End Sub

isabelle


Bonjour,

Je souhaite creer une liste des mes albums mp3, peut on directement importer
un dossier et ses sous dossiers de l'explorateur windows dans excel?

merci


Avatar
marc
Merci isabelle,
c'est tres bien, mais si je veux importer en meme temps les sous dossier?
merci


bonjour Marc,

oui c'est possible il y a plusieurs version de macro qui font la chose.
moi j'utilise toujours celle ci :

Sub ListeTousLesFichiersDunDossier()
Dim fso As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, I As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
Répertoire = "c:zaza" 'Modifie le répertoire
If Répertoire = "" Then Exit Sub
Set Dossier = fso.getfolder(Répertoire)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each File In Files
Fichier = File.Name
x = x + 1
Range("A" & x) = Fichier
Next
End If
End Sub


isabelle


Bonjour,

Je souhaite creer une liste des mes albums mp3, peut on directement importer
un dossier et ses sous dossiers de l'explorateur windows dans excel?

merci





Avatar
isabelle
j'ai ajouté une ligne (.SearchSubFolders = True):

Sub TousLesFichiersDunDossier2()
Set fs = Application.FileSearch
With fs
.LookIn = "C:zaza"
.SearchSubFolders = True
.Filename = "*.*"
.Execute
For I = 1 To .FoundFiles.Count
x = x + 1
Range("A" & x) = .FoundFiles(I)

Next I
If .FoundFiles.Count = 0 Then
MsgBox "Aucun fichier n'a été trouvé."
End If
End With
End Sub

isabelle


Merci isabelle,
c'est tres bien, mais si je veux importer en meme temps les sous dossier?
merci



bonjour Marc,

oui c'est possible il y a plusieurs version de macro qui font la chose.
moi j'utilise toujours celle ci :

Sub ListeTousLesFichiersDunDossier()
Dim fso As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, I As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
Répertoire = "c:zaza" 'Modifie le répertoire
If Répertoire = "" Then Exit Sub
Set Dossier = fso.getfolder(Répertoire)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each File In Files
Fichier = File.Name
x = x + 1
Range("A" & x) = Fichier
Next
End If
End Sub


isabelle



Bonjour,

Je souhaite creer une liste des mes albums mp3, peut on directement importer
un dossier et ses sous dossiers de l'explorateur windows dans excel?

merci







Avatar
Michel Pierron
Bonjour marc;

Sub MP3_Listing()
Dim sPath As String: sPath = GetShellFolder
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then Exit Sub
Dim Headers(35), x%, y&, i&, p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.NameSpace(CStr(sPath))
Application.ScreenUpdating = False
Workbooks.Add
For i = 0 To 34
Headers(i) = oFolder.GetDetailsOf(oFolder.Items, i)
Select Case i
Case 0 To 1, 10, 12, 14 To 18, 20 To 22
x = x + 1
Cells(1, x) = Headers(i)
End Select
Next
y = 1
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 1, 10, 12, 14 To 18, 20 To 22
x = x + 1
Cells(y, x) = oFolder.GetDetailsOf(oFile, i)
With ActiveSheet
.Hyperlinks.Add .Range("A" & y), Hlink(p), , n, n
End With
End Select
Next
End If
Next
Range("A2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Font.Bold = True
Cells.Columns.AutoFit
Range("A1").Select
Set oFolder = Nothing: Set objShell = Nothing
End Sub

Private Function GetShellFolder() As String
Const Title = "Sélectionnez un répertoire !"
Dim oSHA As Object, oSF As Object, oItem As Object
On Error GoTo 1
Set oSHA = CreateObject("Shell.Application")
Set oSF = oSHA.BrowseForFolder(0, Title, &H1 Or &H10, &H11)
If InStr(TypeName(oSF), "Folder") <> 1 Then Exit Function
For Each oItem In oSF.parentfolder.Items
If oItem.Name = oSF.Title Then
GetShellFolder = oItem.Path
Exit Function
End If
Next
GetShellFolder = oSF.Title
Set oSF = Nothing: Set oSHA = Nothing
Exit Function
1: MsgBox "Error: " & Err.Number & vbLf & Err.Description, 48
End Function

Private Function Hlink(p As String) As String
Hlink = "file:///" & Replace(Replace(p, " ", "%20"), "", "/")
End Function

MP


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

Bonjour,

Je souhaite creer une liste des mes albums mp3, peut on directement
importer
un dossier et ses sous dossiers de l'explorateur windows dans excel?

merci