MACRO TO PLAY MP3, etc. FILE USING MS MEDIA PLAYER (SOLVED)

[BrianB]

* * * PLEASE DO NOT REPLY TO THIS MESSAGE * * * *
Edited to include separate macro to close the application
Keywords : Media Player mp3 wav wmp avi play files
I wanted to be able to play music files direct from my Excel CD tracks database, and got to this stage as a starter. A problem was that I was unable to get any of the 'Shell' parameters to run minimized working - played file but stayed hidden. Solved with SendKeys.

There is a separate routine to close the application. It uses the Window title. Also works with .avi files etc.

May need tweaks to run on your system. Experiment with line positions and parameters of Wait times, Sendkeys (True/False), and DoEvents.

'=======================================================================
'- EXCEL MACRO TO PLAY A MUSIC FILE USING MICROSOFT MEDIA PLAYER
'- Brian Baulsom October 2005.   Excel 2000
'=======================================================================
' 1. Skin "revert" gives miniature player in the TaskBar when minimized
' 2. Media Player COMMAND LINE PARAMETERS reference
' http://msdn.microsoft.com/library/d...us/wmplay10/mmp_sdk/commandlineparameters.asp
'------------------------------------------------------------------------------------
' 3. Memo : VBA 'Shell' parameters
'  vbMaximizedFocus,vbMinimizedFocus,vbMinimizedNoFocus,vbNormalFocus,vbNormalNoFocus
'------------------------------------------------------------------------------------
'- API to get handle of the active window (no need to know its name)
Public Declare Function M_GetActiveWindow Lib "user32" _
    Alias "GetActiveWindow" () As Long
'----------------------------------------------------------------------
'- API to bring window to top
Public Declare Function BringWindowToTop Lib "user32.dll" _
    (ByVal Hwnd As Long) As Long
'-----------------------------------------------------------------------
'- API to get window handle from its caption
Public Declare Function FindWindow Lib "user32.dll" _
    Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
'--------------------------------------
'=======================================================================
'- MAIN ROUTINE
'=======================================================================
Sub PlayFile()
    PlayMusicFile ("F:\MyMusic\FileName.mp3")
    MsgBox ("Done")
End Sub
'- END OF MAIN ==========================================================
'
'
'========================================================================
'- SUBROUTINE TO PLAY THE FILE
'========================================================================
Sub PlayMusicFile(PathFileName As String)
    Dim FileName As String  ' without path
    Dim ExcelHandle As Long
    Dim MediaPlayerApp As String
    Dim ShellString As String
    Dim Quote As String
    '---------------------------------------------------------------------
    '- extract filename and save as named range RefersTo for closing later
    FileName = GetFileFromPath(PathFileName)
    ThisWorkbook.Names.Add Name:="FileName", RefersTo:=CStr(FileName)
    Quote = Chr(34) ' quotation mark character
    ActiveSheet.Range("A1").Select ' remove focus from button on sheet
    '---------------------------------------------------------------------
    '- get Excel API Window Handle
    ExcelHandle = M_GetActiveWindow()
    '----------------------------------------------------------------------
    '- Windows Media Player Path
    'MediaPlayerApp = "C:\Program Files\Windows Media Player\mplayer2.exe"   ' winNT
    MediaPlayerApp = "C:\Program Files\Windows Media Player\wmplayer.exe"
    '----------------------------------------------------------------------
    '- Make up string for Shell method
    '- MPlayer command line needs quotation marks - so we have to add them
    'ShellString = MediaPlayerApp      '  & " " & Quote & PathFileName & Quote
    ShellString = MediaPlayerApp & " " & Quote & PathFileName & Quote
    '----------------------------------------------------------------------
    '- Open Media Player and run the file
    '- I cannot get Minimize parameters to work, so Normal screen
    RSP = Shell(ShellString, vbNormalFocus)
    If RSP = 0 Then PlayFileError = True: Exit Sub
    Application.Wait Now + TimeValue("00:00:01")
    '----------------------------------------------------------------------
    '- Use SendKeys Alt + Space + N to minimize screen
    SendKeys "% ", False
    DoEvents
    Application.Wait Now + TimeValue("00:00:01")
    SendKeys "N", False
    Application.Wait Now + TimeValue("00:00:01")
    DoEvents
    '----------------------------------------------------------------------
    '- bring Excel back to the top
    RSP = BringWindowToTop(ExcelHandle)
End Sub
'
'========================================================================
'- FUNCTION TO GET FILENAME FROM FULL PATH (CALLED FROM ABOVE ROUTINE)
'========================================================================
Public Function GetFileFromPath(MyPath As String)
    Dim MyLen As Integer
    MyLen = Len(MyPath)
    '-------------------------------------
    '- loop
    For x = MyLen To 1 Step -1
        If Mid(MyPath, x, 1) = "\" Then Exit For
    Next
    '------------------------------------------------------------------
    GetFileFromPath = Right(MyPath, MyLen - x)
End Function
'=========================================================================

'========================================================================
'- SUBROUTINE TO CLOSE MEDIA PLAYER
'========================================================================
Sub STOP_PLAYER()
    Dim WindowName As String
    Dim MediaPlayerHandle As Long
    Dim FileName As String
    Dim MyLen As Integer
    '---------------------------------------------------------------------
    '- * NOT NEEDED. LATEST MEDIA PLAYER HAS NO FILE NAME IN HEADER
    '- get stored file name - is in the form  [="xxxx.xxx"]
'    FileName = ThisWorkbook.Names("Filename").RefersTo
'    MyLen = Len(FileName)
'    FileName = Mid(FileName, 3, MyLen - 3)
'    '- get window from name (using filename & application)
'   WindowName = FileName & " - " & "Windows Media Player"
    '-------------------------------------------------------------------
    WindowName = "Windows Media Player"
    MediaPlayerHandle = FindWindow(CLng(0), WindowName)
    RSP = BringWindowToTop(MediaPlayerHandle)
    If RSP = 0 Then
        MsgBox (WindowName & vbCr & "Problem geeting window to top.")
        Exit Sub
    End If
    '- window is minimized so Enter to open then Alt+F4 to close
    'SendKeys "~", True     ' open window [not necessary with some versions]
    SendKeys "%{F4}", True  ' close application
End Sub
'========================================================================