CÔNG TY CỔ PHẦN BLUESOFTS

CÔNG TY CỔ PHẦN BLUESOFTS

Lập trình VBA với BSStreamX, BSStream - Nhúng và chạy file MP3 trong Excel

 BSStreamX là control cho phép nhúng bất kỳ file nào vào trong ứng dụng của bạn, khi file ứng dụng mang sang máy tính khác không cần phải mang theo file mà bạn đã nhúng trong BSStreamX vì nó đã được nhúng bên trong. 

Trong bài viết này tôi hướng dẫn cách nhứng file MP3 và chạy nhạc MP trong Excel VBA.

Download Source Code

Bước 1: Nhúng BSStreamX vào Userform hoặc Worksheet
Nhấp chuột vào biểu tượng BSStreamX, nhìn cửa sổ Properties, chọn Custome... thực hiện thao tác nạp file MP3 hay các bấy kể file nào bạn muốn nhúng trong ứng dụng.

Bước 2: Viết code để chạy
Tạo module: Trong VBA, vào menu Tools->Insert Module, dán những đoạn code dưới đây.

 

 



'---CODE----
Option Explicit 
'Huong dan lap trinh Windows API - Chay nhac MP3
'Nguyen Duy Tuân - http://bluesofts.net
'Facebook: https://www.facebook.com/groups/hocexcel
#If VBA7 Then 
Private Declare PtrSafe Function mciSendString Lib "Winmm.dll" Alias "mciSendStringW" ( ByVal lpszCommand As String, ByVal lpszReturnString As String, ByVal cchReturn As Long, ByVal hwndCallback As LongPtr) As Long 
#Else 
Private Declare Function mciSendString Lib "Winmm.dll" Alias "mciSendStringW" ( ByVal lpszCommand As String, ByVal lpszReturnString As String, ByVal cchReturn As Long, ByVal hwndCallback As Long) As Long 
#End If 

Sub DoPLAY() 
   Dim sFileMP3 As String 
   Dim sCmd As String 
   Dim x As Long 
   DoSTOP 
   '"C:\DATA\My Music\Em Oi Ha Noi Pho - My Hanh.mp3"
   sFileMP3 = GetPathTemp & Sheet1.BSStreamX1.Key 
   If Not FileExists(sFileMP3) Then  'Check file not exists then save from BSStreamX
      Sheet1.BSStreamX1.SaveToFile sFileMP3  'Save binary from BSStream to file
   End If 
   If FileExists(sFileMP3) Then 
      sCmd = "OPEN """ & sFileMP3 & """ alias tuan" 
      'OPEN
      x = mciSendString(U(sCmd), "", 0, 0) 
      Debug.Print x  'x=0 =>Success
      'PLAY
      x = mciSendString(U("PLAY tuan"), "", 0, 0) 
      Debug.Print x 
   Else 
      Err.Raise 1005, "", "File not exists." 
   End If 
End Sub 

Sub DoSTOP() 
   mciSendString U("STOP tuan"), "", 0, 0 
   mciSendString U("CLOSE tuan"), "", 0, 0 
End Sub 

Function U(ByVal s As String) As String 
   U = StrConv(s, vbUnicode) 
End Function