' Create *.vbs file

' Procedure : RemainderCreate
' Author    : Alexander Panchenko
' Purpose   : Create task for Windows Task Scheduler and vba-file for displayed msg
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and other)
'
' Revision History:
' Rev       Date(dd-mm-yyyy)        Description
' **************************************************************************************
' 2         30-06-2016              Initial Release
'---------------------------------------------------------------------------------------

Public Function RemainderCreate(FILENAME As String, Notes As String, header As String, RemDay As Variant, RemTime As Variant)
    Dim create_file_name As String, create_task As String, strComputer As String
    Dim objWMIService As Object, objNewJob As Object, errJobCreate As Boolean
    create_file_name = Environ("PROGRAMDATA") & "\" & FILENAME & ".vbs"
    
    Dim RandSound
    RandSound = Int((4 * Rnd) + 1)
    Call MsgBox(Notes, vbInformation, "Remind me:")
    
    Open create_file_name For Output As #1
      
    Print #1, "Option Explicit"
    Print #1, "Dim SoundFile"
    Print #1, "Dim result"
    Print #1, "Dim wsh"
    Print #1, "Dim obj"
    Print #1, "Set wsh = CreateObject(""WScript.Shell"")"
    Print #1, "SoundFile = """; CurrentProject.Path & "\" & RandSound & ".mp3"""
    Print #1, "Call Play(SoundFile)"
    Print #1, "wsh.Run (""schtasks /Delete /TN " & FILENAME & " /f""), 0"
    Print #1, "Set obj = CreateObject(""Scripting.FileSystemObject"")"
    Print #1, "obj.DeleteFile(""" & Environ("PROGRAMDATA") & "\" & FILENAME & ".vbs"")"
    Print #1, "'*******************************************'"
    Print #1, "Sub Play(SoundFile)"
    Print #1, "    Dim oPlayer"
    Print #1, "    Set oPlayer = CreateObject(""WMPlayer.OCX"")"
    Print #1, "' Play audio"
    Print #1, "    oPlayer.URL = SoundFile"
    Print #1, "    oPlayer.settings.volume = 100"
    Print #1, "    oPlayer.settings.setMode ""loop"", True"
    Print #1, "    result=MsgBox (""" & Notes & """, vbOKOnly + vbSystemModal, """ & header & """ )"
    Print #1, "    do while result <> VbOk   "
    Print #1, "    oPlayer.controls.play "
    Print #1, "    While oPlayer.playState <> 1 ' 1 = Stopped"
    Print #1, "        WScript.Sleep 100"
    Print #1, "    Wend"
    Print #1, "    loop"
    Print #1, "    oPlayer.close"
    Print #1, "End Sub "
    Close #1
    
'Add to sheduler cmd version
    Dim wsh As Object
    Set wsh = VBA.CreateObject("WScript.Shell")
    create_task = "schtasks /create /sc once /tn """ & FILENAME & _
    """ /tr """ & Environ("PROGRAMDATA") & "\" & FILENAME & ".vbs"" /sd " & RemDay & _
    " /st " & RemTime & ""
    wsh.Run (create_task), 0
    
End Function