Sub start()
' play music for pre determined time
Sheet1.Range("A1").Value = "00:00:00"
Sheet1.Range("A2").Value = "00:00:00"
Sheet1.TextBox2.Value = "00:00:00"
Call randomlyselectsong
If Sheet1.CheckBox1.Value = True Then ' shutdown laptop
Call shutdown 'shut down laptop
End If
'MsgBox ("finished")
End Sub
Dim fs, f1, fc, s
Dim ftp
Dim b 'amount of time to pause for while song plays
'other wise next song play immediately
'used with randum play for set time module
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("C:\users\Dirk pitt\Documents\Dads Music")
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 = """C:\users\Dirk pitt\Documents\Dads Music\" & ftp
Shell "C:\Users\Dirk Pitt\Documents\wmplayer /play /close " & filetoplay
''''''''''''''''''''''''''''''''''''''''
'Sheet1.TextBox2.Value = Range("a3").Text
Range("a2").Value = Sheet1.TextBox2.Value 'time music played before current song
Sheet1.TextBox2.Value = Range("a3").Text ' total time music played after current song
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("C:\Users\Dirk Pitt\Documents\Dads Music\", 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
