Bestandenlijst met calc verwerken

[WV1302]

Ik had graag bestandenlijst naar een werkblad geplaatst, enkel de bestandsnamen.
bv d:\mp3 al de filenamen van de bestanden. Is er een formule of manier om dit te doen?
En kan deze lijst dan telkens geupdate worden met een macro?

 

[edmoor]

Dat kan, en is al eerder gedaan. Er zijn meerdere Excel bestanden te downloaden die dit doen.
Dit is er 1 van:
http://spreadsheetpage.com/index.php/file/mp3_file_lister/

 

[WV1302]

Thx Edmoor, ik heb uw link onmiddellijk uitgeprobeerd maar het werkt blijkbaar alleen in excel. Ik krijg steeds als ik op start klik een foutmelding "er trad een scripting Framework-fout op tijdens het uitvoeren van het unknown script"
En zoals de beschrijving vermeld ben ik ook eens gaan zien naar de macro, maar dat is voor mij te hoog gegrepen.

Rem Attribute VBA_ModuleType=VBAModule
Sub Module1
Rem Option Explicit
Rem ' By John Walkenbach
Rem ' Maybe be distributed freely, but not sold
Rem
Rem 'API declarations
Rem Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Rem Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Rem
Rem Declare Function SHBrowseForFolder Lib "shell32.dll" _
Rem Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Rem
Rem Public Type BROWSEINFO
Rem hOwner As Long
Rem pidlRoot As Long
Rem pszDisplayName As String
Rem lpszTitle As String
Rem ulFlags As Long
Rem lpfn As Long
Rem lParam As Long
Rem iImage As Long
Rem End Type
Rem
Rem Sub GetAllFiles()
Rem Dim Msg As String
Rem Dim Directory As String
Rem Msg = "Select the directory that contains the MP3 files. All subdirectories will be included."
Rem Directory = GetDirectory(Msg)
Rem If Directory = "" Then Exit Sub
Rem If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
Rem Worksheets("Sheet1").Activate
Rem Cells.Clear
Rem Call RecursiveDir(Directory)
Rem End Sub
Rem
Rem Function GetDirectory(Optional Msg) As String
Rem Dim bInfo As BROWSEINFO
Rem Dim path As String
Rem Dim r As Long, x As Long, pos As Integer
Rem ' Root folder = Desktop
Rem bInfo.pidlRoot = 0&
Rem ' Title in the dialog
Rem If IsMissing(Msg) Then
Rem bInfo.lpszTitle = "Select a folder."
Rem Else
Rem bInfo.lpszTitle = Msg
Rem End If
Rem ' Type of directory to return
Rem bInfo.ulFlags = &H1
Rem ' Display the dialog
Rem x = SHBrowseForFolder(bInfo)
Rem ' Parse the result
Rem path = Space$(512)
Rem r = SHGetPathFromIDList(ByVal x, ByVal path)
Rem If r Then
Rem pos = InStr(path, Chr$(0))
Rem GetDirectory = Left(path, pos - 1)
Rem Else
Rem GetDirectory = ""
Rem End If
Rem End Function
Rem
Rem
Rem Public Sub RecursiveDir(ByVal currdir As String)
Rem Dim Dirs() As String
Rem Dim NumDirs As Long
Rem Dim filename As String
Rem Dim PathAndName As String
Rem Dim i As Long
Rem Dim Row As Long
Rem
Rem ' Make sure path ends in backslash
Rem If Right(currdir, 1) <> "\" Then currdir = currdir & "\"
Rem
Rem Application.ScreenUpdating = False
Rem
Rem ' Put column headings on active sheet
Rem Cells(1, 1) = "Path"
Rem Cells(1, 2) = "Filename"
Rem Cells(1, 3) = "Artist"
Rem Cells(1, 4) = "Album"
Rem Cells(1, 5) = "Title"
Rem Cells(1, 6) = "Track#"
Rem Cells(1, 7) = "Genre"
Rem Cells(1, 8) = "Duration"
Rem Cells(1, 9) = "Size"
Rem Range("A1:I1").Font.Bold = True
Rem
Rem ' Get files
Rem filename = Dir(currdir & "*.*", vbDirectory)
Rem Do While Len(filename) <> 0
Rem If Left$(filename, 1) <> "." Then 'Current dir
Rem PathAndName = currdir & filename
Rem If (GetAttr(PathAndName) And vbDirectory) = vbDirectory Then
Rem 'store found directories
Rem ReDim Preserve Dirs(0 To NumDirs) As String
Rem Dirs(NumDirs) = PathAndName
Rem NumDirs = NumDirs + 1
Rem Else
Rem If UCase(Right(filename, 3)) = "MP3" Then
Rem Row = WorksheetFunction.CountA(Range("A:A")) + 1
Rem Cells(Row, 1) = currdir 'path
Rem Cells(Row, 2) = filename 'filename
Rem Cells(Row, 3) = FileInfo(currdir, filename, 20) 'artist
Rem Cells(Row, 4) = FileInfo(currdir, filename, 14) 'album
Rem Cells(Row, 5) = FileInfo(currdir, filename, 21) 'title
Rem Cells(Row, 6) = FileInfo(currdir, filename, 26) 'track
Rem Cells(Row, 7) = FileInfo(currdir, filename, 16) 'genre
Rem Cells(Row, 8) = FileInfo(currdir, filename, 27) 'duration
Rem Cells(Row, 9) = Application.Round(FileLen(currdir & filename) / 1024, 0) 'size
Rem Application.StatusBar = Row
Rem End If
Rem End If
Rem End If
Rem filename = Dir()
Rem Loop
Rem ' Process the found directories, recursively
Rem For i = 0 To NumDirs - 1
Rem RecursiveDir Dirs(i)
Rem Next i
Rem Application.StatusBar = False
Rem End Sub
Rem
Rem Function FileInfo(path, filename, item) As Variant
Rem Dim objShell As IShellDispatch4
Rem Dim objFolder As Folder3
Rem Dim objFolderItem As FolderItem2
Rem
Rem Set objShell = CreateObject("Shell.Application")
Rem Set objFolder = objShell.Namespace(path)
Rem Set objFolderItem = objFolder.ParseName(filename)
Rem FileInfo = objFolder.GetDetailsOf(objFolderItem, item)
Rem
Rem Set objShell = Nothing
Rem Set objFolder = Nothing
Rem Set objFolderItem = Nothing
Rem End Function
Rem
End Sub

 

[edmoor]

Oeps! Niet op gelet dat het geen Excel betrof.
Sorry.