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
2,502 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
  • 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
 
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
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
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 500 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

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Suggested Solutions

Parsing a CSV file is a task that we are confronted with regularly, and although there are a vast number of means to do this, as a newbie, the field can be confusing and the tools can seem complex. A simple solution to parsing a customized CSV fi…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

758 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

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now