Some days later I didn't find an edit button any more... so here comes a new version which should work better.
(I did include a "option explicit" and didn't check it properly as I was running an old version... sigh).
Improved the flag parsing and added a "prefix" constant for naming of the m3us if someone is interested.
' credits:
' http://www.hydrogenaud.io/forums/index.php?showtopic=46167
' http://www.hydrogenaud.io/forums/index.php?showtopic=46167&st=0&p=408550&#entry408550
option explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const PreFix = "" ' Set this string if you want your playlists with a given prefix (like "- classical - ")
dim shutup, delete, args, argc, fso, dirsort
' Set shutup = false if you really want to torture your mousebutton
shutup = true
delete = false
' Parse command-line arguments
set args = WScript.Arguments
for argc = 0 to args.Count-1
if LCase(args(argc)) = "-d" then
delete = true
end if
if LCase(args(a)) = "-v" then
shutup = false
end if
next
' Write m3u files for current directory tree
set dirsort = CreateObject("System.Collections.ArrayList")
set fso = CreateObject("Scripting.FileSystemObject")
wscript.echo WriteM3u(fso.GetAbsolutePathName("."), 0) & " files written"
' Recursive function to write m3u files for a given path
function WriteM3u(path, depth)
dim mp3List, count, fdr, subFolder, f, m3u, m3uName, m3uFile
if not shutup then
wscript.echo Space(depth*2) & "Working in path = """ & path & """" & " delete = " & delete
end if
count = 0
set fdr = fso.GetFolder(path)
' Write m3u file for each subfolder
if fdr.SubFolders.Count > 0 then
for each subFolder in fdr.SubFolders
' Recurse into subfolders
count = count + WriteM3u(subFolder.path, depth + 1)
next
end if
' If no files found in subfolders, write m3u file for this folder
if count = 0 then
if not shutup then
wscript.echo Space(depth*2) & "Scanning """ & fdr.Path & """"
end if
' Build list of mp3/ogg/flac files
' 1st: create array
for each f in fdr.Files
if lcase(right(f.Name, 3)) = "mp3" or lcase(right(f.Name, 3)) = "ogg" or lcase(right(f.Name, 4)) = "flac" then
dirsort.Add f.Name
end if
next
' 2nd: sort array
dirsort.Sort()
' 3rd: generate mp3list:
mp3List = ""
for each f in dirsort
mp3List = mp3List & f & VBCrLf
next
' 4th: prepare next list (empty this array)
dirsort.clear
' If any files found, write m3u file
if mp3List <> "" then
' Multi-disc folder handling
if len(fdr.Name) = 6 and left(fdr.Name, 5) = "Disc " then
m3uName = PreFix & fdr.ParentFolder.Name & " (" & fdr.Name & ").m3u"
else
m3uName = PreFix & fdr.Name & ".m3u"
end if
' Existing m3u file handling
m3u = path & "\" & m3uName
if fso.FileExists(m3u) then
if delete then
if not shutup then
wscript.echo Space(depth*2) & " ... deleting existing file"
end if
fso.DeleteFile m3u
else
if not shutup then
wscript.echo Space(depth*2) & " ... renaming existing file"
end if
fso.MoveFile m3u, m3u & ".old"
end if
end if
' Write new m3u file
if not shutup then
wscript.echo Space(depth*2) & " ... writing """ & m3uName & """"
end if
set m3uFile = fso.OpenTextFile(m3u, ForWriting, True)
m3uFile.Write(mp3List)
m3uFile.Close
count = 1
else
wscript.echo Space(depth*2) & " ... no mp3/ogg files found"
end if
else
if not shutup then
wscript.echo Space(depth*2) & "files found in subfolders"
end if
end if
' Return m3u file count
WriteM3u = count
end function