Option Explicit
On Error Resume Next

Dim fso
Dim playList
Dim file
Dim fileCollection
Dim folder
Dim folderCollection
Dim subfolder
Dim mp3Folder
Dim fileName
Dim extension
Dim extensions
Dim folderOrDrive

'*************************
'Update information here
mp3Folder = "D:\"
playList = "_playlist.m3u"
extensions = "mp3:wav:wma"
'*************************

Set fso = CreateObject("Scripting.FileSystemObject")
Set mp3Folder = fso.GetFolder(mp3Folder)

If Right(mp3Folder, 1) = "\" Then folderOrDrive = "Drive" Else folderOrDrive = "Folder"

If folderOrDrive = "Drive" Then
	Set playList = fso.CreateTextFile(mp3Folder + playList, True)
Else 'folderOrDrive = "Folder"
	Set playList = fso.CreateTextFile(mp3Folder + "\" + playList, True)
End if

RecursiveAdd(mp3Folder)
playList.Close

Function RecursiveAdd(folder)
	On Error Resume Next
	Set fileCollection = folder.Files
	
	For Each file In fileCollection
		extension = Right(file,3)
		If Instr(1,extensions,extension,1) > 0 Then
			If folderOrDrive = "Drive" Then
				fileName = Right(file,(Len(file) - Len(mp3Folder)))
			Else 'folderOrDrive = "Folder"
				fileName = Right(file,(Len(file) - (Len(mp3Folder) + 1)))
			End if
			playList.WriteLine(fileName)
		End if
	Next 'file
	
	Set folderCollection = folder.SubFolders

	For Each subfolder In folderCollection
		RecursiveAdd(subfolder)
	Next 'subfolder
End Function