使用 VBA Excel 播放任何音频文件
Posted
技术标签:
【中文标题】使用 VBA Excel 播放任何音频文件【英文标题】:Play any audio file using VBA Excel 【发布时间】:2015-01-01 17:09:57 【问题描述】:我有一段代码可以读取大多数音频文件(包括 wav、mp3、midi...),但如果路径或文件名中有空格,它将无法工作。
所以我必须恢复到接受它的其他代码,但只读取 wav 文件...
这是读取所有类型音频的代码:
Option Explicit
Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _
hwndCallback As Long) As Long
Private sMusicFile As String
Dim Play
Public Sub Sound2(ByVal File$)
sMusicFile = File 'path has been included. Ex. "C:\3rdMan.mp3
Play = mciSendString("play " & sMusicFile, 0&, 0, 0)
If Play <> 0 Then 'this triggers if can't play the file
'Play = mciSendString("'play " & sMusicFile & "'", 0&, 0, 0) 'i tried this aproach, but doesn't seem to work
End If
End Sub
Public Sub StopSound(Optional ByVal FullFile$)
Play = mciSendString("close " & sMusicFile, 0&, 0, 0)
End Sub
非常感谢任何帮助,(我不想使用外部播放器弹出解决方法,也不想停止使用 VBA)
【问题讨论】:
“它不起作用”是什么意思?你有错误吗? (可能不是,因为您对On Error Resume Next
语句的使用不当)。找出引发的具体错误,它可能更容易为您提供帮助。这将需要至少暂时摆脱On Error Resume Next
。
为什么要播放音频?我是讨厌这种功能的用户之一。
它不会引发错误,但如果 sMusicFile 中包含空格,它根本不会播放...
您是否遵循了@DavidZemens 的出色建议并摆脱了On Error Resume Next
?有了它,您将无法看到引发的任何错误。
您可能需要对空格进行转义或编码,或者将字符串放在引号中。但是如果没有看到当你摆脱错误语句时会发生什么,很难确定。
【参考方案1】:
我找到了解决方法,纠正路径名中的空格(和(编辑)文件名(使用没有空格的文件副本,丑陋但有效(name as
不是一个好的解决方案):
第一次尝试播放声音后,如果失败,我将当前目录更改为声音目录(暂时):
If Play <> 0 Then
Dim path$, FileName0$
path = CurDir
If InStr(sMusicFile, ":") > 0 Then ChDrive (Left(sMusicFile, 1))
If InStr(sMusicFile, "\") > 0 Then
ChDir (Left(sMusicFile, InStrRev(sMusicFile, "\") - 1))
FileName0 = Mid(sMusicFile, InStrRev(sMusicFile, "\") + 1)
If InStr(FileName0, " ") > 0 Then
FileCopy FileName0, Replace(FileName0, " ", "")
sMusicFile = Left(sMusicFile, InStrRev(sMusicFile, "\")) & Replace(FileName0, " ", "")
Play = mciSendString("play " & Replace(FileName0, " ", ""), 0&, 0, 0)
Else
Play = mciSendString("play " & FileName0, 0&, 0, 0)
End If
Else
FileName0 = Replace(sMusicFile, " ", "")
If sMusicFile <> FileName0 Then
FileCopy sMusicFile, FileName0
sMusicFile = FileName0
End If
Play = mciSendString("play " & sMusicFile, 0&, 0, 0)
End If
ChDrive (Left(path, 1))
ChDir (Left(path, InStrRev(path, "\") - 1))
End If
注意:对于名称中的空格,我还有一个新方法:Filecopy sMusicFile replace(sMusicFile," ","%")
然后播放这个新文件
【讨论】:
【参考方案2】:走老派……想想 DOS。 例如: "C:\Way Too Long\Long Directory\File.mp3" 变成 "C:\WayToo~1\LongDi~1\File.mp3" 诀窍是去掉空格并将目录和文件名保持在 8 个字符以下。为此,请删除所有空格,然后在前 6 个字符后截断并添加波浪号 (~) 和数字一。 我试过这个方法,对我来说效果很好。 需要注意的一件事是,如果在缩短的目录名称中存在歧义(例如“\Long File Path\”和“\Long File Paths\”和“\Long File Path 1436\”),那么您需要调整波浪号后面的数字(“\LongFi~1\”和“\LongFi~2\”和“\LongFi~3\”,按照创建目录的顺序)。 因此,有可能之前的文件夹名为“FilePa~1”并被删除,而留下了类似名称的“FilePa~2”。因此,您的文件路径可能不会自动以“~1”为后缀。它可能是“~2”或更高的值,具体取决于有多少类似命名的目录或文件名。 我发现 35 年前发布的 dos 令人难以置信,而 VBA 程序员仍然不得不处理这个目录问题的恐龙!
【讨论】:
【参考方案3】:试试:
Public Sub Sound2(ByVal File$)
If InStr(1, File, " ") > 0 Then File = """" & File & """"
sMusicFile = File
...
如果有空格,这会将路径用引号括起来,这是某些 API 函数所必需的。
【讨论】:
【参考方案4】:以下解决方案无需复制文件即可工作。
它将您的代码与Get full path with Unicode file name 中来自 osknows 的代码结合在一起,并结合了上面 Jared 的想法......
Option Explicit
Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As Any, 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 lBuffer As Long) As Long
Private sMusicFile As String
Dim Play, a
Public Sub Sound2(ByVal File$)
sMusicFile = GetShortPath(File)
Play = mciSendString("play " & sMusicFile, 0&, 0, 0)
If Play <> 0 Then 'this triggers if can't play the file
'Play = mciSendString("'play " & sMusicFile & "'", 0&, 0, 0) 'i tried this aproach, but doesn't seem to work
End If
End Sub
Public Sub StopSound(Optional ByVal FullFile$)
Play = mciSendString("close " & sMusicFile, 0&, 0, 0)
End Sub
Public Function GetShortPath(ByVal strFileName As String) As String
'KPD-Team 1999
'URL: [url]http://www.allapi.net/[/url]
'E-Mail: [email]KPDTeam@Allapi.net[/email]
Dim lngRes As Long, strPath As String
'Create a buffer
strPath = String$(165, 0)
'retrieve the short pathname
lngRes = GetShortPathName(strFileName, strPath, 164)
'remove all unnecessary chr$(0)'s
GetShortPath = Left$(strPath, lngRes)
End Function
【讨论】:
【参考方案5】:该函数将长的完整文件名转换为 8.3 短格式。
Function get8_3FullFileName(ByVal sFullFileName As String) As String
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
get8_3FullFileName = FSO.GetFile(sFullFileName).ShortPath
End Function
试试看。
【讨论】:
请为您提供的代码添加解释。谢谢!以上是关于使用 VBA Excel 播放任何音频文件的主要内容,如果未能解决你的问题,请参考以下文章