[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 3224
  • Last Modified:

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 have code that will let you record audio in excel for say 10 seconds or 20 etc. I would like to modify the code so that it will record until I tell it to stop
the code is listed below
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
    
'// 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 strCloseCmd As String = "Close " & strAlias
'// Save recorded sound as
Private Const strSaveAs As String = "C:\Users\benny\Documents\test.wav"

Sub TestRecording()
Dim strCommand As String
Dim ExecCmd As Long
Dim tWait

'// Define Time to record for in Secs
tWait = 5

'// Open default recorder > Dosen't Show
ExecCmd = mciSendString(strOpenCmd, vbNullString, 0, 0&)
'// Start recording
ExecCmd = mciSendString(strRecordCmd, vbNullString, 0, 0&)
'// Set the Recording time
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 o 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

Open in new window

0
Dov_B
Asked:
Dov_B
  • 10
  • 9
1 Solution
 
Chris BottomleyCommented:
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
0
 
Chris BottomleyCommented:
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

Open in new window

0
 
Dov_BAuthor Commented:
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
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Chris BottomleyCommented:
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
0
 
Dov_BAuthor Commented:
thank you for all your efforts but it still crashes after about 10-12 seconds
0
 
Chris BottomleyCommented:
What version of windows/office?
0
 
Dov_BAuthor Commented:
2003
0
 
Dov_BAuthor Commented:
windows xp
office 2003
0
 
Dov_BAuthor Commented:
woops sorry windows 7
office 2003
0
 
Chris BottomleyCommented:
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
0
 
Dov_BAuthor Commented:
thanx for all the effort I have 2003 on an xp I will try it out
0
 
Chris BottomleyCommented:
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

Open in new window

0
 
Dov_BAuthor Commented:
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
0
 
Chris BottomleyCommented:
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
0
 
Chris BottomleyCommented:
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

Open in new window

0
 
Chris BottomleyCommented:
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
0
 
Dov_BAuthor Commented:
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
0
 
Chris BottomleyCommented:
Are you talking the latest code because I resolved those issues therein.

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:\Users\benny\Documents\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

0
 
Dov_BAuthor Commented:
Thank you so much for working this out over such an extended period of time
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 10
  • 9
Tackle projects and never again get stuck behind a technical roadblock.
Join Now