使用 VBA Excel 播放任何音頻文件

Question

我有一段代碼可以讀取大多數音頻文件（包括 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）

Answer 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," ","%")然后播放這個新文件

Answer 2

去老派......想想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 程序員仍然不得不處理這個目錄問題的恐龍！

Answer 3

嘗試：

Public Sub Sound2(ByVal File$)

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

sMusicFile = File

...

如果有空格，這會將路徑用引號括起來，這是某些 API 函數所必需的。

Answer 4

以下解決方案無需復制文件即可工作。

它將您的代碼與來自 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]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

Answer 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

嘗試一下。