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 mciGetErrorString Lib "winmm" Alias _ "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _ ByVal uLength 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
Sub PlayAVIAudioOFF(FileName As String) Dim RetVal As Long Dim CommandString As String Dim ShortFileName As String * 260 Dim deviceIsOpen As Boolean
RetVal = GetShortPathName(FileName, ShortFileName, Len(ShortFileName)) FileName = Left$(ShortFileName, RetVal) CommandString = "Open " & FileName & " type avivideo alias AVIFile" RetVal = mciSendString(CommandString, vbNullString, 0, 0&) If RetVal Then GoTo error deviceIsOpen = True CommandString = "set AVIFile audio all off" RetVal = mciSendString(CommandString, vbNullString, 0, 0&) If RetVal Then GoTo error CommandString = "Play AVIFile wait" RetVal = mciSendString(CommandString, vbNullString, 0, 0&) If RetVal Then GoTo error CommandString = "Close AVIFile" RetVal = mciSendString(CommandString, vbNullString, 0, 0&) If RetVal Then GoTo error
Exit Sub error: Dim ErrorString As String ErrorString = Space$(256) mciGetErrorString RetVal, ErrorString, Len(ErrorString) ErrorString = Left$(ErrorString, InStr(ErrorString, vbNullChar) - 1)
If deviceIsOpen Then CommandString = "Close AVIFile" mciSendString CommandString, vbNullString, 0, 0& End If
Err.Raise 999, , ErrorString
End Sub |