?
Solved

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

Posted on 2010-08-19
19
Medium Priority
?
3,003 Views
Last Modified: 2012-05-10
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
Comment
Question by:Dov_B
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 10
  • 9
19 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33482493
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33483808
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
 

Author Comment

by:Dov_B
ID: 33486399
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!

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33491609
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
 

Author Comment

by:Dov_B
ID: 33496254
thank you for all your efforts but it still crashes after about 10-12 seconds
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33496406
What version of windows/office?
0
 

Author Comment

by:Dov_B
ID: 33496460
2003
0
 

Author Comment

by:Dov_B
ID: 33496462
windows xp
office 2003
0
 

Author Comment

by:Dov_B
ID: 33496464
woops sorry windows 7
office 2003
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33496491
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
 

Author Comment

by:Dov_B
ID: 33496511
thanx for all the effort I have 2003 on an xp I will try it out
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33498589
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
 

Author Comment

by:Dov_B
ID: 33507625
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33507924
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33507975
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33508046
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
 

Author Comment

by:Dov_B
ID: 33509740
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
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 33509934
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
 

Author Closing Comment

by:Dov_B
ID: 33515898
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.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Calculating holidays and working days is a function that is often needed yet it is not one found within the Framework. This article presents one approach to building a working-day calculator for use in .NET.
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question