Dim fs, f1, fc, s
Dim ftp
Dim b 'amount of time to pause for while song plays
'other wise next song play immediately
Public Sub randomlyselectsong()
Dim mm ' minutes
Dim ss ' seconds
Do Until Sheet1.TextBox2.Value > Sheet1.TextBox1.Value
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.GetFolder("path to folder where songs are stored")
Randomize
i = CInt((Rnd() * f.Files.Count) + 1)
j = 1
For Each fi In f.Files
If j = i Then
ftp = fi.Name 'fi, randomly selected song
Call RecursiveDir(Directory)
filetoplay = """path to folder where songs are stored\" & ftp
Shell "C:\path\wmplayer /play /close " & filetoplay
''''''''''''''''''''''''''''''''''''''''
'Sheet1.TextBox2.Value = Range("a3").Text
Range("a2").Value = Sheet1.TextBox2.Value
Sheet1.TextBox2.Value = Range("a3").Text
ss = Right(b, 2) ' gets far right 2 charectors
mm = Mid(b, 4, 2) 'starting at 4 from left, gets the 4th and 5th charector
b = mm * 60 + ss
pause (b) ' how long to wait in seconds before playing next song
'''''''''''''''''''''''''''''''''''''''''
End If
j = j + 1
Next
Loop
End Sub
Public Sub RecursiveDir(ByVal currdir As String)
Range("A1").Select
Range("a1").Value = FileInfo("path to folder where music is stored\", ftp, 27)
End Sub
Function FileInfo(path, filename, item) As Variant
' this gets the file duration
Dim objShell As IShellDispatch4
Dim objFolder As Folder3
Dim objFolderItem As FolderItem2
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(path)
Set objFolderItem = objFolder.ParseName(filename)
FileInfo = objFolder.GetDetailsOf(objFolderItem, 27)
b = FileInfo ' song run time. used to pause macro while song plays
Set objShell = Nothing
Set objFolder = Nothing
Set objFolderItem = Nothing
End Function
Sub pause(seconds As Single)
Dim TimeEnd As Long
TimeEnd = Timer + seconds
If TimeEnd > 86390 Then
TimeEnd = 0
End If
Do
DoEvents
Loop Until TimeEnd <= Timer
End Sub