Sub m3u()
  CreateObject("scripting.filesystemobject"). _
    CreateTextFile(ThisWorkbook.Path & "\1.m3u", True).Write _
    Join(WorksheetFunction.Transpose(Selection.Columns(1).Value), vbCrLf)
End Sub

Sub CreatePlayList()
    Dim sf$, fname$, m3u$
    Dim sStr$, ExtensionName$, FoldName$
    Dim Folder As Object, File As Object

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then
            Exit Sub
        Else
            sf = .SelectedItems(1)
        End If
    End With

    With CreateObject("Scripting.FileSystemObject")
        Set Folder = .GetFolder(sf)
        FoldName = Folder.Name
        For Each File In Folder.Files
            fname = File.Name
            ExtensionName = .GetExtensionName(fname)
            Select Case ExtensionName
            Case "m1a", "m4a", "m4b", "mp1", "mp2", "mp3", "mpa", "wav", "wave", "wma"
                sStr = sStr & vbCrLf & .GetBaseName(fname) & "." & ExtensionName
            End Select
        Next
        sStr = Mid$(sStr, 3)
        m3u = InputBox("Введите имя файла", "Create PlayList", "! " & FoldName)
        If Len(m3u) Then
            Set File = Folder.CreateTextFile(m3u & ".m3u", True)
            File.Write (sStr)
            File.Close
        End If
    End With
End Sub