FormにWindowsMediaPlayerを貼り付ける例はありますが、Declareで宣言する例はないようです。
Midiファイルは標準で入っているtown.midを使用しています。
Midiファイルは2分くらい再生されます。意外に音が大きいかもしれません。
MIDIというと個別のノート再生をする例もあります。将来はそれも考えています。コメントアウトしている部分があるのはそのためです。
ちなみにOutlookで再生しました。
Class モジュール
Option Explicit
'Class name :MidiClass
'2018/12/28
# If Win64 Then
Private Declare PtrSafe Function midiOutOpen Lib "winmm.dll" (lphMidiOut As LongPtr, ByVal uDeviceID As Long, ByVal dwCallback As LongPtr, ByVal dwInstance As LongPtr, ByVal dwflags As Long) As Long
Private Declare PtrSafe Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As LongPtr) As Long
Private Declare PtrSafe Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As LongPtr, ByVal dwMsg As Long) As Long
Private Declare PtrSafe Function mciExecute Lib "winmm.dll" _
(ByVal lpstrCommand As String) As Long
# Else
Private Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwflags As Long) As Long
Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Private Declare Function mciExecute Lib "winmm.dll" _
(ByVal lpstrCommand As String) As Long
# End If
# If Win64 Then
Private hMidiOut1 As LongLong
# Else
Private hMidiOut1 As Long
# End If
Private m_bAudio As Boolean
Private mf As String 'Midi File
' 初期化処理
Private Sub Class_Initialize()
m_bAudio = False
mf = ""
End Sub
Public Sub MidiOpen()
MidiClose
midiOutOpen hMidiOut1, 0, 0, 0, 0
End Sub
' 終了時処理
Private Sub Class_Terminate()
Call MidiClose
End Sub
Public Sub MidiClose()
midiOutClose hMidiOut1
hMidiOut1 = 0
End Sub
Public Sub MidiSetInstrument(ByVal InstrumentID As Long)
If hMidiOut1 = 0 Then MidiOpen
midiOutShortMsg hMidiOut1, (256 * InstrumentID) + 192
End Sub
Public Sub Midi(action As String, MidiFileName As String)
If Dir(MidiFileName) = "" Then
MsgBox MidiFileName & vbCrLf & "Does Not Exist."
Exit Sub
End If
'Call MidiClose
'Call StopMIDI(mf)
mciExecute action & " " & MidiFileName
End Sub
Public Sub PlayMIDI(mf As String)
Midi "play", mf
End Sub
Public Sub StopMIDI(mf As String)
Midi "stop", mf
End Sub
' プロパティプロシージャ
Property Get PlayMidiFileName(getMidifilename As String) As String
mf = getMidifilename
End Property
標準モジュール
Sub testPlaymidiFile()
Dim clsMIDi As New MidiClass
Set clsMIDi = New MidiClass
clsMIDi.Midi "play", "C:\Windows\Media\town.mid"
End Sub