使用 vba excel 播放任何音频文件

Play any audio file using vba excel

提问by Patrick Lepelletier

and happy New Year.

新年快乐。

I have currently a piece of code wich can read most audio files (including wav, mp3, midi...), but it wont work if there are spaces in the path or File name.

我目前有一段代码可以读取大多数音频文件（包括 wav、mp3、midi...），但如果路径或文件名中有空格，它将无法工作。

so i have to revert to my other code wich accepts it, but read only wav files...

所以我必须恢复到我接受它的其他代码，但只读取 wav 文件......

this is th code for reading all type of 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:rdMan.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

Any help much appreciated, (i don't want workaround with external player popup, nor wich i can't stop from playing with vba)

非常感谢任何帮助，（我不想解决外部播放器弹出窗口，也不想停止使用 vba）

采纳答案by Patrick Lepelletier

i found The work-around, that correct spaces in path name (and (edit) for file name (using copy of file with no spaces, ugly but works (name aswould not be a good solution) :

我找到了解决方法，即文件名的路径名（和（编辑）中的正确空格（使用没有空格的文件副本，丑陋但有效）（name as不是一个好的解决方案）：

After the first attempt to play the sound, if fails i change the current directory to the sound directory (temporarely):

第一次尝试播放声音后，如果失败，我将当前目录更改为声音目录（暂时）：

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

Note : for spaces in the name i got also a new method : Filecopy sMusicFile replace(sMusicFile," ","%")and then play this new file

注意：对于名称中的空格，我还有一个新方法：Filecopy sMusicFile replace(sMusicFile," ","%")然后播放这个新文件

回答by Jared Seltzer

Go old-school...think DOS.
For example:
"C:\Way Too Long\Long Directory\File.mp3"
becomes
"C:\WayToo~1\LongDi~1\File.mp3"

The trick is to get rid of spaces and keep directories and filenames under 8 characters. To do this, remove all spaces, then truncate after the first 6 characters and add a tilde (~) plus the number one.
I tried this method and it worked perfectly for me.

One thing to be cautious of is that if there is a chance of ambiguity in a shortened directory name (like "\Long File Path\" and "\Long File Paths\" and "\Long File Path 1436\") then you'll need to adjust the number after the tilde ("\LongFi~1\" and "\LongFi~2\" and "\LongFi~3\", in the order in which the directories were created).

Therefore, it is possible that a previous folder was called "FilePa~1" and was deleted while a similarly named "FilePa~2" was left. So your file path may not automatically be suffixed with a "~1". It might be "~2" or something higher, depending on how many similarly named directories or filenames there were.

I find it incredible that dos was released 35 years ago, and VBA programmers are still having to deal with this dinosaur of a problem with directories!

去老派......想想DOS。
例如：
"C:\Way Too Long\Long Directory\File.mp3"
变成
"C:\WayToo~1\LongDi~1\File.mp3"

诀窍是去掉空格并将目录和文件名保持在 8 以下人物。为此，请删除所有空格，然后在前 6 个字符后截断并添加波浪号 (~) 和数字 1。
我试过这种方法，它对我来说非常有效。

需要注意的一件事是，如果缩短的目录名称（如“\Long File Path\”和“\Long File Paths\”和“\Long File Path 1436\”）中存在歧义的可能性，那么您需要调整波浪号后的数字（“\LongFi~1\”和“\LongFi~2\”和“\LongFi~3\”，

因此，前一个文件夹可能被称为“FilePa~1”并被删除，而留下一个类似名称的“FilePa~2”。因此，您的文件路径可能不会自动以“~1”为后缀。它可能是“~2”或更高，这取决于有多少类似命名的目录或文件名。

我觉得不可思议的是，dos 是在 35 年前发布的，而 VBA 程序员仍然不得不处理这个目录问题的恐龙！

回答by gordon613

The following solution works without having to copy the file.

以下解决方案无需复制文件即可工作。

It incorporates your code together with code from osknows in Get full path with Unicode file namewith the idea from Jared above...

它将您的代码与来自 osknows 的代码合并在一起，使用 Unicode 文件名的完整路径，其想法来自上述 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][email protected][/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

回答by Sam

Try:

尝试：

Public Sub Sound2(ByVal File$)

If InStr(1, File, " ") > 0 Then File = """" & File & """"

sMusicFile = File

...

This will wrap the path in quotes if there is a space, which is required for some API functions.

如果有空格，这会将路径用引号括起来，这是某些 API 函数所必需的。