使用vba excel播放任何audio文件
新年快乐。
我目前有一段代码可以读取大部分audio文件（包括wav，mp3，midi …），但是如果path或文件名中有空格，它将无法工作。
所以我不得不恢复到我接受它的其他代码，但只能读取wav文件…
这是读取所有types的audio的代码：
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 任何帮助非常感谢，（我不想要外部播放器popup的解决方法，也不是我不能停止使用vba）
去老派…想想DOS。
例如：
“C：\ Way To Long \ Long Directory \ File.mp3”
变
“C：\ WayToo〜1 \帝〜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”被删除。 所以你的文件path可能不会自动添加“〜1”后缀。 它可能是“〜2”或更高，这取决于有多less类似名称的目录或文件名。
我发现35年前dos被释放了，令人难以置信的是，VBA程序员仍然不得不用目录来处理这个恐龙的问题！
尝试：
Public Sub Sound2(ByVal File$) If InStr(1, File, " ") > 0 Then File = """" & File & """" sMusicFile = File ...
如果有一些API函数需要的空间，这将会把path换成引号。
我find了解决方法，正确的空间在path名称（和（编辑）文件名称（使用文件的副本，没有空格，丑陋，但作品（ name as不会是一个好的解决scheme）：
第一次尝试播放声音后，如果失败，我将当前目录更改为声音目录（暂时）：
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," ","%") ，然后播放这个新的文件
以下解决scheme不需要复制文件。
它将你的代码和osknows中的代码结合在一起，用Jared的想法获取Unicode文件名的完整path 。
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