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

I think your approach with strTimeCmd makes the record a fixed length and cannot be stopped if you can define your time as a VBA function then you can use

If you do not use this the recording becomes open ended and can be stopped by a call to a stop command:

Private Const strStopCmd As String = "Stop " & strAlias

Chris

Try for example TestRecording in the modified code below:

Chris

Option Explicit
'//
'// 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
'//
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
    
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:\deleteme\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

'// 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"
timerStop
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 timerStop
    TID = SetTimer(0, 0, intSecs * 1000, AddressOf timerKill)
    bolTimerRunning = True
End Sub

Public Sub timerStop()
    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

Select allOpen in new window

thank you that does indeed allow me to stop but if I dont stop in about 10 seconds excel crashes I tried incrasing the twait variable but then I get an overflow error
also I would like to be able tto stop it without the message box but instead with a key on the keyboard

MOdified the call to timerstart as:

Public Sub timerStart(intSecs As Integer)
    If bolTimerRunning Then timerStop
    TID = SetTimer(0, 0, CLng(intSecs) * 1000, AddressOf timerKill)
    bolTimerRunning = True
End Sub

As for a key on the keyboard can't think how that could be implemented let alone be reliable (because of the need to stop and tidy up).  Not necessarily impossible but not something considered / investigated either.

Chris

thank you for all your efforts but it still crashes after about 10-12 seconds

What version of windows/office?

2003

windows xp
office 2003

woops sorry windows 7
office 2003

Ah

Don't have a copy of Win 7 to test against ... but I can try xp with 2003 tomorrow so will try that.

It would be intersting even if only to rule in/out issues if you can test anywhere else as well.

FWIW I am using Vista with 2007 in this case.

Chris

thanx for all the effort I have 2003 on an xp I will try it out

Found a bug that wasn't apparent on my pc which caused the code to crash so hopefully ... !

Chris

'//
'// 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
'//
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

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:\deleteme\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

'// 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, CLng(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

Select allOpen in new window

now it does not crash but it does not record either by the way in this last bit of code you sent me in the declarations the lines were not split up correctly
and two of them turned red when I pasted into vba excell so I sepperated them

In re the syntax errors that was posting the code from the 2003 machine which wouldn't let me post to EE to my normal one where I can and something must have happened in the copies.

I didn't have a mike on that pc so i'll retry the modified here where I have.

Chris

I did have some issues with devices on the normal pc, but have tried again below which seems to record for me.

Chris

Option Explicit

'//
'// 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
'//
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
    
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:\deleteme\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

Select allOpen in new window

Apologies ... for my tests I needed to change the output file so you need to replace:

Private Const strSaveAs As String = "C:\deleteme\test.wav"
with (of course)
Private Const strSaveAs As String = "C:\Users\benny\Documents\test.wav"

Chris

I had made that change but still it does not record I am sorry for troubling you so much and appreciate the help you are giving me
I think perhaps that last snippet of code you sent me got currpted a bit because some of the lines were together when they should have been sepperated
perhaps you could resend the code

Thank you so much for working this out over such an extended period of time

Apologies for replying to such an old thread but this is something I've been trying to figure out for a long time.  I am hoping to solve the "type mismatch error" I am getting on line #146 of Chris Bottomley's solution at the bottom of the thread.
Here is the relevant portion:

144: Public Sub timerStart(intSecs As Integer)
145:     If bolTimerRunning Then StopTimer
146:     TID = SetTimer(0, 0, intSecs * 1000, AddressOf timerKill)
147:     bolTimerRunning = True
148: End Sub
149:
150: Public Sub StopTimer()
151:     KillTimer 0, TID
152: End Sub
153:
154: Public Sub timerKill(hWnd As Long, uMsg As Long, ID As Long, SysTime As Long)
155:     Application.SendKeys "~", True
156:     If bolTimerRunning Then StopTimer
157: End Sub

Select allOpen in new window

The VB editor is highlighting "AdressOf timerKill" on line 146 with the type mismatch error.
If replying to old threads like this is not allowed, kindly advise and I will repost as a new
question. 

I retired some time back and have not touched VBA for some years so cannot possibly comment on current syntax/semantics.

If things were the same then I guess the variable is declared and in scope based on the message therefore with timerKill defined a few lines later you need to consider other aspects like for example is sendKeys still valid.

Short answer tho is ask your own question and I am sure the experts will be on it!

Chris