Lire un fichier WAV en VBA

Version imprimable

Salut la compagnie,

avant sous Windows XP32 / Excel 2003, pour lire un fichier WAV en VBA j'utilisais le code suivant :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Function MessageSonore(P_Fichier_wav)
    Application.ScreenUpdating = False
 
    WFichier_txt = G_DOSSIER_SPEECH & "\" & P_Fichier_wav
    If Test_Fichier(WFichier_txt, False) = True Then
            ShellWait "sndrec32 /play /Close " & WFichier_txt
    Else
            ShellWait "sndrec32 /play /Close " & G_DOSSIER_SPEECH & "\" & "message_sonore_inexistant.wav"
    End If
End Function
 
Public Sub ShellWait(ByVal JobToDo As String)
Dim hProcess As Long, RetVal As Long
 
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo, vbMinimizedNoFocus))
    Do
        GetExitCodeProcess hProcess, RetVal
        DoEvents
    Loop While RetVal = STILL_ACTIVE
End Sub

Mais depuis, je suis sous Seven64 / Excel 2003 et ça ne fonctionne plus, car le fichier SNREC32.EXE n'est plus présent.

La question est donc comment faire, maintenant ?

Merci d'avance pour votre aide.

heu

bonjour

oui effectivement grosse galère avec ce code archaïque

sinon une piste

Code:

1
2
3
4
5
6
7
8
'il y a la fonction mciexecute
Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
 
 
 Sub lire_wav()
'si le fichier existe tu l'entendra
If Dir("chemin complet de ton fichier") <> "" Then mciExecute ("play " & "chemin complet de ton fichier")
End Sub

au plaisir

Merci beaucoup.
Tout à l'air de fonctionner.
Pour que ça serve à tout le monde, voici le petit code utilisé

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 
'Fonctions pour les messages sonores.
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400
Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
'
Function MessageSonore(P_Fichier_wav)
    Application.ScreenUpdating = False
 
    WFichier_txt = G_DOSSIER_SPEECH & "\" & P_Fichier_wav
    If Test_Fichier("C:\windows\system32\sndrec32.exe", False) = True Then ' Windows XP
        If Test_Fichier(WFichier_txt, False) = True Then
                ShellWait "sndrec32 /play /Close " & WFichier_txt
        Else
                ShellWait "sndrec32 /play /Close " & G_DOSSIER_SPEECH & "\" & "message_sonore_inexistant.wav"
        End If
    Else 'Windows SEVEN
        If Test_Fichier(WFichier_txt, False) = True Then
            mciExecute ("play " & WFichier_txt)
        Else
            mciExecute ("play " & G_DOSSIER_SPEECH & "\" & "message_sonore_inexistant.wav")
        End If
    End If
End Function
 
Public Sub ShellWait(ByVal JobToDo As String)
    Dim hProcess As Long, RetVal As Long
 
    If Test_Fichier("C:\windows\system32\sndrec32.exe", False) = True Then
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo, vbMinimizedNoFocus))
        Do
            GetExitCodeProcess hProcess, RetVal
            DoEvents
        Loop While RetVal = STILL_ACTIVE
    End If
End Sub

27/11/2012, 14h11
patricktoulon

re

bonjour

c'est bien que ton code fonctionne mais pour moi il n'est pas nécessaire de garder l'ancien système

meme avec XP l'api "mciExecute " est parfaitement gérer aussi par xp
du moins il me semble d'autre infirmeront ou confirmeront
au plaisir