Randomize playlist

[5SRopp]

I have a scoreboard that shows our operators how much of each commodity needs to built for each hour of the workday. Ten minutes before each hour a song automatically plays to alert our workers that they need to hustle. As of now my randomizer chooses from a set list of songs located in a folder, these songs have gotten old. Is there a way to use my randomizer to access say Pandora or some other streaming music site at the same time every hour so that the music played isn't heard over and over? Below is what my macro looks like






Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub MyMacro()

Application.OnTime TimeValue("00:50:00"), "MyMacro"
Application.OnTime TimeValue("1:50:00"), "MyMacro"
Application.OnTime TimeValue("2:50:00"), "MyMacro"
Application.OnTime TimeValue("3:50:00"), "MyMacro"
Application.OnTime TimeValue("4:50:00"), "MyMacro"
Application.OnTime TimeValue("5:50:00"), "MyMacro"
Application.OnTime TimeValue("6:50:00"), "MyMacro"
Application.OnTime TimeValue("7:50:00"), "MyMacro"
Application.OnTime TimeValue("8:50:00"), "MyMacro"
Application.OnTime TimeValue("9:50:00"), "MyMacro"
Application.OnTime TimeValue("10:50:00"), "MyMacro"
Application.OnTime TimeValue("11:50:00"), "MyMacro"
Application.OnTime TimeValue("12:50:00"), "MyMacro"
Application.OnTime TimeValue("13:50:00"), "MyMacro"
Application.OnTime TimeValue("14:50:00"), "MyMacro"
Application.OnTime TimeValue("15:50:00"), "MyMacro"
Application.OnTime TimeValue("16:50:00"), "MyMacro"
Application.OnTime TimeValue("17:50:00"), "MyMacro"
Application.OnTime TimeValue("18:50:00"), "MyMacro"
Application.OnTime TimeValue("19:50:00"), "MyMacro"
Application.OnTime TimeValue("20:50:00"), "MyMacro"
Application.OnTime TimeValue("21:50:00"), "MyMacro"
Application.OnTime TimeValue("22:50:00"), "MyMacro"
Application.OnTime TimeValue("23:50:00"), "MyMacro"


Dim MyNumber As Integer
Dim Song As String
Randomize Timer
MyNumber = Application.WorksheetFunction.RoundUp(Rnd() * 16, 0)

Select Case True
Case MyNumber = 1
Song = "C:\Users\iowa\Music\song1"


Case MyNumber = 2
Song = "C:\Users\iowa\Music\song2"

Case MyNumber = 3
Song = "C:\Users\iowa\Music\song3"

Case MyNumber = 4
Song = "C:\Users\iowa\Music\song4"

Case MyNumber = 5
Song = "C:\Users\iowa\Music\song5"

Case MyNumber = 6
Song = "C:\Users\iowa\Music\song6"

Case MyNumber = 7
Song = "C:\Users\iowa\Music\song7"

Case MyNumber = 8
Song = "C:\Users\iowa\Music\song8"



End Select

Dim handle As Long
handle = ShellExecute(0, "Open", Song, 0, 0, SW_SHOWNORMAL)


End Sub

 

[Ruddles]

Just a point...

The first time you run MyMacro it schedules up 24 calls to MyMacro, one every hour for the rest of the day. Each time one of those 24 MyMacro calls executes, it sets up a further 24 scheduled calls to itself. At the end of the first day you will have scheduled 24 x 24 events to run, 24 of which will have completed, 23 x 24 of which are still waiting.

Do you see what I'm getting at?

You schedule the 24 calls. At 00:50:00 the first one runs. The first thing it does is schedule another one for 00:50:00 (to replace the one which is running), but then it schedules another for 01:50:00 even though the first one hasn't run yet, another for 02:50:00 even though the first one hasn't run yet, etc.

When 01:50:00 comes around, it schedules another call for 01:50:00, but also another one for 02:50:00 even though there are two already outstanding, etc.

 

[5SRopp]

That would explain the frequent crashes late in the day. Would making a variable i and looping i 1 to 23 alleviate the rescheduling?

 

[Ruddles]

Delete all of those Application.OnTime commands. Place this at the top of your procedure:-

Dim dtNextSchedule As Date

And place this after the ShellExecute command:-

dtNextSchedule = [COLOR=red]TimeSerial(Format(Now() - Int(Now()) + TimeSerial(0, [COLOR=blue]10[/COLOR], 0), "hh"), [COLOR=blue]50[/COLOR], 0)[/COLOR]

Application.OnTime dtNextSchedule, "MyMacro"

The bit in red works out when the next scheduled time is. If you want to change this to - for example - eight minutes to the hour, you just to change the values in blue to 8 and 52.

 

[5SRopp]

I've changed the code from what it was to what's below. The timer still does not seem to trigger correctly. Example, at every 50 minutes past the hour a random song should begin to play. 7:50, 8:50, 9:50 etc.. Once the spreadsheet is open I want to be able to run the macro and not have to worry until the system is shut down. Any ideas why the music is not executing?

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Sub NewMacro()

Dim handle As Long
Dim dtNextSchedule As Date
Dim MyNumber As Integer
Dim Song As String
Randomize Timer
MyNumber = Application.WorksheetFunction.RoundUp(Rnd() * 16, 0)

Select Case True
Case MyNumber = 1
Song = "C:\Users\jropp\Desktop\MUSIC\1.mp3"

Case MyNumber = 2
Song = "C:\Users\jropp\Desktop\MUSIC\2.mp3"

Case MyNumber = 3
Song = "C:\Users\jropp\Desktop\MUSIC\3.mp3"

Case MyNumber = 4
Song = "C:\Users\jropp\Desktop\MUSIC\4.mp3"

Case MyNumber = 5
Song = "C:\Users\jropp\Desktop\MUSIC\5.mp3"

Case MyNumber = 6
Song = "C:\Users\jropp\Desktop\MUSIC\6.mp3"

Case MyNumber = 7
Song = "C:\Users\jropp\Desktop\MUSIC\7.mp3"

End Select

handle = ShellExecute(0, "Open", Song, 0, 0, SW_SHOWNORMAL)
dtNextSchedule = TimeSerial(Format(Now() - Int(Now()) + TimeSerial(0, 10, 0), "hh"), 50, 0)
Application.OnTime dtNextSchedule, "NewMacro"

End Sub

 

[Ruddles]

1) Place a breakpoint on the Application.OnTime command and see what the value of dtNextSchedule is when you run it the first time.

2) You're generating random numbers from 1 to 16 but you're only playing songs for files 1 to 7 - generating numbers 8-16 won't play a file.

Either put this in before the End Select to catch cases which aren't satisfied:-

Case Else
MsgBox "No CASE for MyNumber =" & MyNumber

or change the random number generator to:-

MyNumber = Application.WorksheetFunction.RoundUp(Rnd() * [COLOR=red][B]7[/B][/COLOR], 0)