Create WMPlayer Playlist in VBA

joshuafournier

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

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
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
You must log in or register to reply here.

Similar threads

B
  • Question Question
Opening Chrome via VBA
Replies
1
Views
2K
BrianExcel
B
T
  • Question Question
Displaying a video in Excel
Replies
3
Views
3K
Logit
Logit
A
  • Question Question
Excel custom ribbon disappears when running macro
Replies
0
Views
1K
avcape
A
V
  • Question Question
Returning Randomly Selected Value from Table based on Criteria
Replies
4
Views
786
Viau1337
V
A
  • Question Question
Excel Reopens
Replies
9
Views
2K
anichols
A

Forum statistics

Threads
1,223,908
Messages
6,175,306
Members
452,633
Latest member
DougMo

Share this page

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