Visual Basic Script to write M3U playlists

Several years ago, I came upon a script that would recursively traverse through a folder tree and create a M3U playlist for each folder respectively. I slightly modified the script to fit my requirements. This script will look for MP3 and WMA files and create a M3U file.

For the desired results, put the script in the root folder of the folder tree that playlists will be created.

For example: Put WriteM3u.vbs into D:\My Music\Elvis to generate playlists for each subfolder of Elvis.

D:\My Music\Elvis\WriteM3u.vbs
D:\My Music\Elvis\Elvis\elvis.m3u
D:\My Music\Elvis\Clambake\clambake.m3u

Create WriteM3u.vbs

Const ForReading = 1, ForWriting = 2, ForAppending = 8

' Parse command-line arguments
delete = false
set args = WScript.Arguments
if args.Count > 0 then
if LCase(args(0)) = "-d" then
delete = true
end if
end if

' Write m3u files for current directory tree
set fso = CreateObject("Scripting.FileSystemObject")
wscript.echo WriteM3u(fso.GetAbsolutePathName("."), delete) & " files written"

' Recursive function to write m3u files for a given path
function WriteM3u(path, delete)
count = 0
set fso = CreateObject("Scripting.FileSystemObject")
set fdr = fso.GetFolder(path)

' Write m3u file for each subfolder
if fdr.SubFolders.Count > 0 then
for each subFolder in fdr.SubFolders
count = count + WriteM3u(subFolder.path, delete)
next
end if

' If no files found in subfolders, write m3u file for this folder
if count = 0 then
wscript.echo "Scanning """ & fdr.Path & """"
' Build list of mp3/wma files
mp3List = ""
for each f in fdr.Files
if right(f.Name, 3) = "mp3" or right(f.Name, 3) = "wma" then
mp3List = mp3List & f.Name & VBCrLf
end if
next

' 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 = fdr.ParentFolder.Name & " (" & fdr.Name & ").m3u"
else
m3uName = fdr.Name & ".m3u"
end if

' Existing m3u file handling
m3u = path & "\" & m3uName
if fso.FileExists(m3u) then
if delete then
wscript.echo "... deleting existing file"
fso.DeleteFile m3u
else
wscript.echo "... renaming existing file"
fso.MoveFile m3u, m3u & ".old"
end if
end if

' Write new m3u file
wscript.echo "... writing """ & m3uName & """"
set m3uFile = fso.OpenTextFile(m3u, ForWriting, True)
m3uFile.Write(mp3List)
m3uFile.Close
count = 1
else
wscript.echo "... no mp3/wma files found"
end if
end if

' Return m3u file count
WriteM3u = count
end function