MS Project2016のVBAで定期的に曲をながしたいが「Application.OnTime 」のところでエラーになってる？

Question

MS Project2016で、

あるファイルを開いたときに、あるmp3の曲（３分くらい）を流し、

その曲が４５分ごとに繰り返し再生される、というマクロを組もうとして挫折しています。

※なお、マクロが正常に動作するかを知るために、とりあえずは４５分ごとではなく５秒ごとに変えています。

で、書いたマクロとエラーメッセージは以下のとおりです。

ThisProject のところに、

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Private Sub Project_Open(ByVal pj As Project)

    'Chariots of Fire - Theme.mp3を流す

    PlaySound

End Sub

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

そして、標準モジュールのところに、

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

 '注！このMS Project は64 bit版なので下記の位置に「PtrSafe」を挿入する必要あり！（32bit版なら不要）

Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _

(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _

ByVal ReturnLength As Long, ByVal hwndCallback As Long) As Long

Sub PlaySound()

    Dim SoundFile As String, rc As Long

    SoundFile = "C:\Users\dicem\・・・・自主規制・・・・\Chariots of Fire - Theme.mp3" '多分有るかと？

    If Dir(SoundFile) = "" Then

        MsgBox SoundFile & vbCrLf & "がありません。", vbExclamation

        Exit Sub

    End If

    SoundFile = Chr(34) & SoundFile & Chr(34) 'スペース対策

    rc = mciSendString("Open " & SoundFile, "", 0, 0)

    rc = mciSendString("Play " & SoundFile, "", 0, 0)

    'rc = mciSendString("Play " & SoundFile & " wait", "", 0, 0)

    '↑演奏が終わるまで処理が返ってこないので没

    'rc = mciSendString("Close " & SoundFile, "", 0, 0)

    If rc <> 0 Then

        MsgBox rc & " ？のエラーです"

    End If 

    '45分ごとに流す・・・マクロが完成するまでは５秒ごとにしておく

    '進捗状況を示すために準備する

    IntervalTime = Now + TimeValue("00:00:05")  '5秒後

    WaitTime = TimeValue("00:00:01")

    Application.OnTime TimeValue(IntervalTime), "PlaySound", TimeValue(WaitTime)

End Sub

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

そして、下記のメッセージが表示されるのとほぼ同時に１回だけは曲が流れます。

このメッセージで「デバッグ」をおすと、

    Application.OnTime TimeValue(IntervalTime), "PlaySound", TimeValue(WaitTime)

の行が黄色くハイライトされます。

どうすればなるのでしょうか？

なお、あまりVBA得意ではなく、上記コードも検索したコードの寄せ集めで１０％くらいしか意味を理解していません。

お手数をお掛けして恐縮ですが、よろしくお願い致します。

Answer 1

調べてみたのですが、エラーの通りで、MS Projectでは

Application.OnTime がサポートされていない（使えない）ようです。

Excel VBAでは

     If rc <> 0 Then

         MsgBox rc & " ？のエラーです"

     End If

の後にrcをクローズする処理を入れたら上手く動きました。

     Application.Wait Now + TimeSerial(0, 0, 5)

     rc = mciSendString("Close " & SoundFile, "", 0, 0)

Sleepを使うと音楽を定期的に鳴らすことは出来ますが、他の処理が出来なくなってしまいますし。。。

ProjectのVBAでTimer処理をどのようにするか

他のフォーラムに投稿されてみてはいかがでしょうか。

Msdnフォーラム

Office 365 フォーラム

Answer 2

ご返信有り難うございます。

MSDNフォーラム で質問させていただきました

↓

https://social.msdn.microsoft.com/Forums/ja-JP/89ed15cd-7c88-43b5-90eb-fb062e1e2113/ms-project2016vbaapplicationontime-?forum=vbajp

どうもありがとうございました。