Create WMPlayer Playlist in VBA

joshuafournier

Board Regular
Joined
Mar 3, 2012
Messages
91
Good Morning,

I am trying to write a code to Open Windows media player, play an .mp4 in fullscreen. The below code works perfect for a single file (substituting the .mp4 with the file name). I have many buttons with videos and need to click different buttons to watch different videos.

what I would like is to have the macro to just loop through every .mp4 in the folder.....looked around and tried many changes.... any help would be appreciated!

Thank You



VBA Code:
Private Sub CommandButton1_Click()
FileToPlay = """H:\02 Images\Drone Mini3 Pro\*.mp4"""
    Shell "C:\Program Files\Windows Media Player\wmplayer /play /fullscreen " & FileToPlay

End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
At this moment FileToPlay contains text instaed of list of mp4
 
Upvote 0
Try this:
VBA Code:
' -------------------------------------
Function getFileList(Path As String, Optional FileFilter As String = "*.mp4*", Optional fso As Object, Optional list As Object) As Object
Dim BaseFolder As Object, f As Object
    If fso Is Nothing Then
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set list = CreateObject("System.Collections.ArrayList")
    End If
    If Not Right(Path, 1) = "\" Then Path = Path & "\"
    If Len(Dir(Path, vbDirectory)) = 0 Then
        MsgBox Path & " not found"
        Exit Function
    End If
    Set BaseFolder = fso.GetFolder(Path)
    For Each f In BaseFolder.SubFolders
        getFileList f.Path, FileFilter, fso, list
    Next
    For Each f In BaseFolder.Files
        If f.Path Like FileFilter Then list.Add f.Path
    Next
    Set getFileList = list
End Function
' -------------------------------------
Function GetFilenameFromPath(ByVal strPath As String) As String
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function
' -------------------------------------
Sub CreatePlayListFromFolder()         'this is main macro ! assign to button or just run
    Dim f As Variant, fileList As Object
    Dim Temp As String
    Dim MyList As String
    Dim counter As Integer: counter = 0
    Set fileList = getFileList("H:\02 Images\Drone Mini3 Pro")    'this is your folder to get mp4 from
    For Each f In fileList
        Temp = Temp & "<media src=""" & f & """/>" & vbCrLf
        counter = counter + 1
    Next
    Call MakeAFile(Temp, counter)
    Shell "C:\Program Files\Windows Media Player\wmplayer /play /fullscreen " & ThisWorkbook.Path & "\test.wpl"
End Sub
' -------------------------------------

Sub MakeAFile(fileList As String, xCounter As Integer)
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(ThisWorkbook.Path & "\test.wpl", True)
a.WriteLine ("<?wpl version=""1.0""?>")
a.WriteLine ("<smil>")
a.WriteLine ("<head>")
a.WriteLine (" <meta name=""Generator"" content=""Microsoft Windows Media Player - 11.0.5721.5145""/>")
a.WriteLine ("<meta name=""ItemCount"" content=""" & xCounter & """/>")
a.WriteLine ("<title>Test</title>")
a.WriteLine ("</head>")
a.WriteLine ("<body>")
a.WriteLine ("<seq>")
a.WriteLine (fileList)
a.WriteLine ("</seq>")
a.WriteLine ("</body>")
a.WriteLine ("</smil>")
a.Close
End Sub
' -------------------------------------
 
Upvote 0

Forum statistics

Threads
1,215,069
Messages
6,122,954
Members
449,096
Latest member
Anshu121

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top