Excel VBA record audio from computer microphone

I need to record audio in excel vba windows 10
the code in the question belo used to work years ago
but Ittried on my 64 bit windows 10 and I think 64 bit office cannot getit to work
does anyone know how to fix this code so it will work on versions of excel commonly found in the last two years to date?
https://www.experts-exchange.com/questions/26416850/I-have-code-that-records-audio-in-excel-vba-for-a-set-period-of-time-I-need-help-modifying-it-so-that-I-can-turn-it-off-and-on-when-I-want.html
Dov BhatiaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Kenneth HobsonCivil EngineerCommented:
Usually, one adds PtrSafe. See the commented links for more details.

'64 bit api, https://www.jkp-ads.com/articles/apideclarations.asp
'https://docs.microsoft.com/en-us/office/vba/language/concepts/getting-started/64-bit-visual-basic-for-applications-overview
'https://docs.microsoft.com/en-us/previous-versions/office/developer/officetalk2010/ff700513(v%3Doffice.11)

'//
'// Use MCI functions to record a WAV file.
'// The main MCI function is mciSendString, that sends command
'// strings to the system MCI device and executes them.
'// The device that the command is sent to is specified in the command string.
'// In this case it is the waveaudio
'//
#If VBA7 Then
  Private Declare PtrSafe Function mciSendString Lib "winmm" _
     Alias "mciSendStringA" ( _
     ByVal lpstrCommand As String, _
     ByVal lpstrReturnString As String, _
     ByVal uReturnLength As Long, _
     ByVal hwndCallback As Long) As Long
  
  Private Declare PtrSafe Function mciExecute Lib "winmm" ( _
     ByVal lpstrCommand As String) As Long
  
  Private Declare PtrSafe Function sndPlaySound Lib "winmm.dll" _
     Alias "sndPlaySoundA" ( _
     ByVal lpszSoundName As String, _
     ByVal uFlags As Long) As Long
      
  Declare PtrSafe Function SetTimer Lib "user32" ( _
      ByVal hWnd As Long, _
      ByVal nIDEvent As Long, _
      ByVal uElapse As Long, _
      ByVal lpTimerFunc As Long) As Long
  
  Declare PtrSafe Function KillTimer Lib "user32" ( _
      ByVal hWnd As Long, _
      ByVal nIDEvent As Long) As Long

  #Else
  Private Declare Function mciSendString Lib "winmm" _
     Alias "mciSendStringA" ( _
     ByVal lpstrCommand As String, _
     ByVal lpstrReturnString As String, _
     ByVal uReturnLength As Long, _
     ByVal hwndCallback As Long) As Long
  
  Private Declare Function mciExecute Lib "winmm" ( _
     ByVal lpstrCommand As String) As Long
  
  Private Declare Function sndPlaySound Lib "winmm.dll" _
     Alias "sndPlaySoundA" ( _
     ByVal lpszSoundName As String, _
     ByVal uFlags As Long) As Long
      
  Declare Function SetTimer Lib "user32" ( _
      ByVal hWnd As Long, _
      ByVal nIDEvent As Long, _
      ByVal uElapse As Long, _
      ByVal lpTimerFunc As Long) As Long
  
  Declare Function KillTimer Lib "user32" ( _
      ByVal hWnd As Long, _
      ByVal nIDEvent As Long) As Long
#End If
      
Public intSecs As Integer
Public bolTimerRunning As Boolean
Public TID As Long

'// Sound constants
Private Const SND_SYNC = &H0
Private Const SND_ASYNC = &H1
Private Const SND_NODEFAULT = &H2
Private Const SND_LOOP = &H8
Private Const SND_NOSTOP = &H10

'// Define your Alias handle
Private Const strAlias As String = "RcrdWavFile "
Private Const strOpenCmd As String = "Open new type waveaudio alias " & strAlias
Private Const strRecordCmd As String = "Record " & strAlias
Private Const strTimeCmd As String = "Record " & strAlias & " to "
'// Note the time length in msecs comes before this const eg 10000 WAIT
Private Const strWaitCmd As String = " WAIT"
Private Const strSaveCmd As String = "Save " & strAlias
Private Const strStopCmd As String = "Stop " & strAlias
Private Const strCloseCmd As String = "Close " & strAlias
'// Save recorded sound as
'Private Const strSaveAs As String = "C:\Users\benny\Documents\test.wav"
Private Const strSaveAs As String = "C:\temp\test.wav"


Sub TestRecording()
  Dim strCommand As String
  Dim ExecCmd As Long
  Dim tWait
  Dim intDispose As Integer
  Dim hr As Integer
  Dim mn As Integer
  Dim sec As Integer
  Dim nw As Variant
  Dim resp As Integer
  Dim wsShell As Object
  
  If bolTimerRunning Then bolTimerRunning = False
  '// Define Time to record for in Secs
  tWait = 10
  intDispose = 1
  
  '// Open default recorder > Dosen't Show
  ExecCmd = mciSendString(strOpenCmd, vbNullString, 0, 0&)
  '// Start recording
  ExecCmd = mciSendString(strRecordCmd, vbNullString, 0, 0&)
  '// Set the Recording time
  nw = Now()
  'hr = Hour(nw)
  'mn = Minute(nw)
  'sec = Second(nw) + tWait
  'Do While Now() < Date + TimeSerial(hr, mn, sec)
  timerStart CInt(tWait)
  MsgBox "Stop Recording Y/N?", , "Record Control"
  StopTimer
  mciSendString strStopCmd, vbNullString, 0, 0&
  'ExecCmd = mciSendString(strTimeCmd & (tWait * 1000) & strWaitCmd, _
     vbNullString, 0, 0&)
  '// Save the recorded sound
  ExecCmd = mciSendString(strSaveCmd & strSaveAs, vbNullString, 0, 0&)
  '// Now close the Handle
  ExecCmd = mciSendString(strCloseCmd, vbNullString, 0, 0&)
  
  '// Tell the user it has finsihed
  MsgBox "Finished recording", vbInformation

End Sub

Sub PlayBack()
   WAVPlay strSaveAs
End Sub

Sub PlayBackLoop()
   WAVLoop strSaveAs
End Sub

Sub PlayBackStop()
'// If your going to play a Loop then you need to STOP IT!
    Call WAVPlay(vbNullString)
End Sub

Sub WAVLoop(File As String)
    Dim SoundName As String
    Dim wFlags As Long
    Dim x As Long
    
    SoundName = File
    wFlags = SND_ASYNC Or SND_LOOP
    x = sndPlaySound(SoundName, wFlags)
    If x = 0 Then MsgBox "Can't play " & File

End Sub

Sub WAVPlay(File As String)
    Dim SoundName As String
    Dim wFlags As Long
    Dim x As Long
    
    SoundName = File
    wFlags = SND_ASYNC Or SND_NODEFAULT
    x = sndPlaySound(SoundName, wFlags)
    If x = 0 Then MsgBox "Can't play " & File

End Sub

'timerstart 3 : msgbox "Hi" : timerStop
Public Sub timerStart(intSecs As Integer)
    If bolTimerRunning Then StopTimer
    TID = SetTimer(0, 0, intSecs * 1000, AddressOf timerKill)
    bolTimerRunning = True
End Sub

Public Sub StopTimer()
    KillTimer 0, TID
End Sub

Public Sub timerKill(hWnd As Long, uMsg As Long, ID As Long, SysTime As Long)
    Application.SendKeys "~", True
    If bolTimerRunning Then StopTimer
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Dov BhatiaAuthor Commented:
Wow! That was quick and totally awesome!! Thank you so much! G-d Bless you!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Windows 10

From novice to tech pro — start learning today.