[RESOLVED] Voice recording Test

[Nightwalker83]

Hi,

Can someone with a microphone please test this code for me. I have tried testing it myself but for some reason my voice is not being picked up by the microphone even though it is switched on.

You need:

Label1 (Label)
Command1 (Command Button)
Command2 (Command Button)
Command3 (Command Button)

Form code

Private Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
 
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
 
Const MAX_PATH As Long = 260
 
Dim url As String
 
Private Sub Command1_Click()
 Command2.Enabled = True
 url = GetShortFileName(ShowOpenDialog(App.Path, "All Files|*.*", "*.*"))
    mciSendString "play " & url, "", 0, 0
     Label1.Caption = "Playing..."
End Sub
Private Function GetShortFileName(ByVal sFileName As String) As String
    Dim sBuffer As String
    sBuffer = String$(MAX_PATH, vbNullChar)
    Call GetShortPathName(sFileName, sBuffer, MAX_PATH)
    GetShortFileName = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End Function
 
Private Sub Command2_Click()
url = ShowSaveAsDialog(App.Path, "", "All Files|*.*", "*.*")
    mciSendString "open new Type waveaudio Alias recsound", url, 0, 0
   mciSendString "record recsound", url, 0, 0
   MsgBox (url)
   Command2.Caption = "Recording..."
   Label1.Caption = "Recording..."
End Sub
 
Private Sub Command3_Click()
 mciSendString "save recsound " & url, "", 0, 0
 mciSendString "close recsound", "", 0, 0
 Command2.Caption = "Stopped..."
 Label1.Caption = "Stopped..."
 MsgBox "File Created: " & url
End Sub
 
Private Sub Form_Load()
 Command1.Caption = "Play"
 Command2.Caption = "Record"
 Command3.Caption = "Stop"
End Sub

and this code from Ellis Dee which, needs to be put in a module (the code that is)

Author: Ellis Dee
'Website: [url]http://www.vbforums.com/showthread.php?t=605402&highlight=Common+Dialog[/url]
       Option Explicit
     
    Private Enum FlagsEnum
        feOpen
        feSaveAs
    End Enum
     
    Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        Flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
    End Type
     
    Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
    Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
     
    ' Common Dialog - Open
    Public Function ShowOpenDialog(pstrInitialPath As String, pstrFilter As String, pstrDefaultExt As String) As String
        Dim typFileName As OPENFILENAME
               
        typFileName = GetStructure(pstrInitialPath, "", pstrFilter, pstrDefaultExt, feOpen)
        If GetOpenFileName(typFileName) Then ShowOpenDialog = Left$(typFileName.lpstrFile, InStr(typFileName.lpstrFile, Chr$(0)) - 1)
    End Function
     
    ' Common Dialog - SaveAs
    Public Function ShowSaveAsDialog(pstrInitialPath As String, pstrFile As String, pstrFilter As String, pstrDefaultExt As String) As String
        Dim typFileName As OPENFILENAME
       
        typFileName = GetStructure(pstrInitialPath, pstrFile, pstrFilter, pstrDefaultExt, feSaveAs)
        If GetSaveFileName(typFileName) Then ShowSaveAsDialog = Left$(typFileName.lpstrFile, InStr(typFileName.lpstrFile, Chr$(0)) - 1)
    End Function
     
    Private Function GetStructure(pstrPath As String, pstrFile As String, pstrFilter As String, pstrDefaultExt As String, penFlags As FlagsEnum) As OPENFILENAME
        Const OFN_FILEMUSTEXIST = &H1000
        Const OFN_PATHMUSTEXIST = &H800
        Const OFN_HIDEREADONLY = &H4
        Const OFN_LONGNAMES = &H200000
        Const OFN_OVERWRITEPROMPT = &H2
        Const OF_WRITE = &H1
        Const MAX_PATH = 260
        Dim frm As Form
     
        With GetStructure
            .lStructSize = Len(GetStructure)
            ' Get any form's window handle
            For Each frm In Forms
                Exit For
            Next
            .hwndOwner = frm.hWnd
            Set frm = Nothing
            .hInstance = App.hInstance
            .lpstrFilter = Replace(pstrFilter, "|", Chr(0)) & Chr(0)
            .nMaxFile = MAX_PATH + 1
            .nMaxFileTitle = MAX_PATH + 1
            .lpstrFileTitle = Space(MAX_PATH)
            .lpstrInitialDir = pstrPath
            .lpstrDefExt = pstrDefaultExt
            Select Case penFlags
                Case feOpen
                    .lpstrTitle = "Open"
                    .lpstrFile = Space(MAX_PATH)
                    .Flags = OFN_FILEMUSTEXIST + OFN_HIDEREADONLY + OFN_LONGNAMES
                Case feSaveAs
                    .lpstrTitle = "Save As"
                    .lpstrFile = pstrFile & Space$(MAX_PATH - Len(pstrFile))
                    .Flags = OFN_PATHMUSTEXIST + OFN_HIDEREADONLY + OFN_LONGNAMES + OF_WRITE ' + OFN_OVERWRITEPROMPT
            End Select
        End With
    End Function

Thanks,

Nightwalker