Input Midi Sync fails ONLY on Excel version 64bit for VBA scripting

user_10642138 0
Viewed 66

I did a small script that works extremely well on any computer with Excel version 32bits, and becomes extremely sluggish on Excel version 64bits on the same computer where an Excel version 32bits was successfully tried!

This is extremely puzzling, besides being unpredictable on 64bits, when it works it stops almost always after 33 seconds. This duration on the 64bits is consistent among different BPM tested from 20 up to 300bpm, above that tempo the VBA script stops or crashes! I suspect it has something to do with memory. However the MidiIn_Event becomes so sluggish on 64bits that it may be a bug on Windows itself!

UPDATE: The script below breaks out the cycle Do While countdown > 0 despite the countdown being greater than 0! So, something is disrupting the cycle while before the countdown reaches zero (for 64bits only).

This is the script:

Option Explicit

Private Const CALLBACK_FUNCTION = &H30000

'INPUT DEVICE ID ENTERED HERE
Private Const MIDI_DEVICE_ID            As Long = 1

'MIDI Functions here: https://docs.microsoft.com/en-us/windows/win32/multimedia/midi-functions
#If Win64 Then
    'For MIDI device INPUT
    Private Declare PtrSafe Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
    Private Declare PtrSafe Function midiInOpen Lib "winmm.dll" (lphMidiIn As LongPtr, ByVal uDeviceID As LongPtr, ByVal dwCallback As Any, ByVal dwInstance As LongPtr, ByVal dwFlags As LongPtr) As Long
    
    Private Declare PtrSafe Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
    Private Declare PtrSafe Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
    Private Declare PtrSafe Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
#Else
    'For MIDI device INPUT
    Private Declare Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
    Private Declare Function midiInOpen Lib "winmm.dll" (lphMidiIn As Long, ByVal uDeviceID As Long, ByVal dwCallback As Any, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
    
    Private Declare Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
    Private Declare Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
    Private Declare Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
#End If

#If Win64 Then
    Private mlngHmidi           As LongPtr
    Private mlngRc              As LongPtr
    Private mlngMidiMsg         As LongPtr
#Else
    Private mlngHmidi           As Long
    Private mlngRc              As Long
    Private mlngMidiMsg         As Long
#End If

'Counters
Private countdown               As Integer
Private function_calls          As Integer
Private function_actions        As Integer
Private pendent_goes            As Integer

'Main Function externally Called
Public Sub runClock()

    'When canceled become able to close opened MIDI Channels!
    On Error GoTo handleCancel
    Application.EnableCancelKey = xlErrorHandler
    
    'Counters Reset
    countdown = 5000 'Press Esc to Stop
    function_calls = 0
    function_actions = 0
    pendent_goes = 0
    
    'Starts listening the Midi Input
    Call midiInOpen(mlngHmidi, MIDI_DEVICE_ID - 1, AddressOf MidiIn_Event, 0, CALLBACK_FUNCTION)
    Call midiInStart(mlngHmidi)
    
    Application.StatusBar = "Started"
    
    'Processes the Countdown for each Midi Message
    Do While countdown > 0
    
        If pendent_goes > 0 Then
            'Shows up the counting down each time a Midi Message is processed
            Application.StatusBar = "Countdown=" & countdown & " | Pendent=" & pendent_goes
            countdown = countdown - 1
            pendent_goes = pendent_goes - 1
        End If
        
    Loop

    'Ends listening the Midi Input
    Call midiInReset(mlngHmidi)
    Call midiInStop(mlngHmidi)
    Call midiInClose(mlngHmidi)

    'Shows the total amount of calls and the amount of messages processed
    Application.StatusBar = "Finish (" & function_calls & ", " & function_actions & ")"
    
handleCancel: 'Handles the Esc key
    If Err.Number = 18 Then
    
        'Ends listening the Midi Input
        Call midiInReset(mlngHmidi)
        Call midiInStop(mlngHmidi)
        Call midiInClose(mlngHmidi)
    
        'Shows the total amount of calls and the amount of messages processed
        Application.StatusBar = "Finish (" & function_calls & ", " & function_actions & ")"
        
    End If
    
End Sub

'CALLBACK FUNCTION PROCESSED ON EACH MIDI MESSAGE GIVENT BY THE INPUT DEVICE
Private Sub MidiIn_Event(ByVal mlngHmidi As LongPtr, ByVal Message As LongPtr, ByVal instance As LongPtr, ByVal dw1 As LongPtr, ByVal dw2 As LongPtr)

    'Excel 32bit: Works without any problem up to 600bpm;
    'Excel 64bit: Sluggish, doesn't work more than 33 seconds and crashes a lot!

    function_calls = function_calls + 1 'Counts all Calls
    
    If Message = 963 Then
    
        function_actions = function_actions + 1 'Counts all Message Inputs
        pendent_goes = pendent_goes + 1 'Adds quantity of Messages to be processed
        
    End If
    
End Sub

I would like to know how to make it work on Excel 64bits like it works on 32bits.

For testing I use the MIDI-OX to generate the Clock Sync midi messages and the loopMIDI as the midi Device input.

Any help is appreciated. Thanks.

This is the last updated code accordingly to suggestions with the following results:

  1. Still disrupts the While cycle for 64bit excel;
  2. Added the version const, now the VBA7 makes it true even for 32 bit Excel versions. Nevertheless the Excel 32bit still works fine.

Updated Script:

Option Explicit

Private Const CALLBACK_FUNCTION = &H30000

'INPUT DEVICE ID ENTERED HERE
Private Const MIDI_DEVICE_ID            As Long = 1

'MIDI Functions here: https://docs.microsoft.com/en-us/windows/win32/multimedia/midi-functions
#If VBA7 Then

    Private Const BIT_VERSION = 64

    'For MIDI device INPUT
    Private Declare PtrSafe Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
    Private Declare PtrSafe Function midiInOpen Lib "winmm.dll" (ByRef lphMidiIn As LongPtr, ByVal uDeviceID As Long, ByVal dwCallback As LongPtr, ByVal dwInstance As LongPtr, ByVal dwFlags As Long) As Long
    
    Private Declare PtrSafe Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
    Private Declare PtrSafe Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
    Private Declare PtrSafe Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
#Else

    Private Const BIT_VERSION = 32

    'For MIDI device INPUT
    Private Declare Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
    Private Declare Function midiInOpen Lib "winmm.dll" (lphMidiIn As Long, ByVal uDeviceID As Long, ByVal dwCallback As Any, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
    
    Private Declare Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
    Private Declare Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
    Private Declare Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
#End If

#If VBA7 Then
    Private mlngHmidi           As LongPtr
    Private mlngRc              As LongPtr
    Private mlngMidiMsg         As LongPtr
#Else
    Private mlngHmidi           As Long
    Private mlngRc              As Long
    Private mlngMidiMsg         As Long
#End If

'Counters
Private countdown               As Integer
Private function_calls          As Integer
Private function_actions        As Integer
Private pendent_goes            As Integer

'Main Function externally Called
Public Sub runClock()

    'When canceled become able to close opened MIDI Channels!
    On Error GoTo handleCancel
    Application.EnableCancelKey = xlErrorHandler
    
    'Counters Reset
    countdown = 5000 'Press Esc to Stop
    function_calls = 0
    function_actions = 0
    pendent_goes = 0
    
    'Starts listening the Midi Input
    Call midiInOpen(mlngHmidi, MIDI_DEVICE_ID - 1, AddressOf MidiIn_Event, 0, CALLBACK_FUNCTION)
    Call midiInStart(mlngHmidi)
    
    Application.StatusBar = "Started"
    
    'Processes the Countdown for each Midi Message
    Do While countdown > 0
    
        If pendent_goes > 0 Then
            'Shows up the counting down each time a Midi Message is processed
            Application.StatusBar = "VERSION=" & BIT_VERSION & " | " & "Countdown=" & countdown & " | Pendent=" & pendent_goes
            countdown = countdown - 1
            pendent_goes = pendent_goes - 1
        End If
        
    Loop

    'Ends listening the Midi Input
    Call midiInReset(mlngHmidi)
    Call midiInStop(mlngHmidi)
    Call midiInClose(mlngHmidi)

    'Shows the total amount of calls and the amount of messages processed
    Application.StatusBar = "Finish (" & function_calls & ", " & function_actions & ")"
    
handleCancel: 'Handles the Esc key
    If Err.Number = 18 Then
    
        'Ends listening the Midi Input
        Call midiInReset(mlngHmidi)
        Call midiInStop(mlngHmidi)
        Call midiInClose(mlngHmidi)
    
        'Shows the total amount of calls and the amount of messages processed
        Application.StatusBar = "Finish (" & function_calls & ", " & function_actions & ")"
        
    End If
    
End Sub

'CALLBACK FUNCTION PROCESSED ON EACH MIDI MESSAGE GIVENT BY THE INPUT DEVICE
Private Sub MidiIn_Event(ByVal mlngHmidi As LongPtr, ByVal Message As Long, ByVal instance As LongPtr, ByVal dw1 As LongPtr, ByVal dw2 As LongPtr)

    'Excel 32bit: Works without any problem up to 600bpm;
    'Excel 64bit: Sluggish, doesn't work more than 33 seconds and crashes a lot!

    function_calls = function_calls + 1 'Counts all Calls
    
    If Message = 963 Then
    
        function_actions = function_actions + 1 'Counts all Message Inputs
        pendent_goes = pendent_goes + 1 'Adds quantity of Messages to be processed
        
    End If
    
End Sub
midi vba excel
0 Answers
Related