玖叶教程网

前端编程开发入门

播放音频 Access数据库功能模块讲解 VBA代码实例

模块

Public filepn As String

Public Declare PtrSafe 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

Public Sub MMPlay(ByRef FileName As String)

mciSendString "close " & FileName, vbNullString, 0, 0

mciSendString "open " & FileName, vbNullString, 0, 0

mciSendString "play " & FileName, vbNullString, 0, 0

End Sub

Public Sub MMStop(ByRef FileName As String)

mciSendString "stop " & FileName, vbNullString, 0, 0

mciSendString "close " & FileName, vbNullString, 0, 0

End Sub

播放音频

Private Sub Command清空列表_Click()

DoCmd.SetWarnings (False)

Dim del_sql As String

del_sql = "Delete From 文件表"

DoCmd.RunSQL del_sql

Me.数据表子窗体.Requery

End Sub

Private Sub Command停止_Click()

Call MMStop(filepn)

End Sub

Private Sub Command选择文件_Click()

On Error Resume Next

Dim vrtSelectedItem

With Application.FileDialog(msoFileDialogFilePicker)

.AllowMultiSelect = True

.Filters.Add "音频文件", "*.MP3", 1

If .Show = -1 Then

For Each vrtSelectedItem In .SelectedItems

'获取文件名和路径

DoCmd.SetWarnings (False)

Dim add_sql As String

add_sql = "Insert Into 文件表 (文件名称,文件路径) Values ('" & 处理文件名(vrtSelectedItem) & "','" & vrtSelectedItem & "')"

DoCmd.RunSQL add_sql

Next vrtSelectedItem

Else

Exit Sub

End If

End With

Me.数据表子窗体.Requery

End Sub

Function 处理文件名(ByVal filepathname As String) As String

On Error Resume Next

处理文件名 = ""

Dim a1 As Long

a1 = InStrRev(filepathname, "\")

处理文件名 = Right(filepathname, Len(filepathname) - a1)

End Function

文件数据表

Private Sub 文件名称_DblClick(Cancel As Integer)

Call MMStop(filepn)

filepn = Me.文件路径

Call MMPlay(filepn)

End Sub

发表评论:

控制面板
您好,欢迎到访网站!
  查看权限
网站分类
最新留言