使用VBA擅长

和欢乐的新年播放任何音频文件。使用VBA擅长

我目前的一块代码至极可以读取大多数的音频文件（包括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）

来源

2015-01-01 Patrick Lepelletier

你是什么意思“这将无法正常工作”？你有错误吗？（可能不会，因为你使用'On Error Resume Next'语句）。找出引发的具体错误，并且可能会更容易为您提供帮助。这将需要至少暂时摆脱“On Error Resume Next”。 –

为什么要播放音频？我是那种讨厌这种功能的用户之一。 –

它不会引发错误，但是如果sMusicFile包含空格，它将根本无法播放... –

我发现解决方法，正确的空间路径名称（和（编辑）的文件名（使用文件的拷贝没有空格，丑陋但作品（name as瓦特乌尔德不是一个很好的解决方案）：

播放声音第一次尝试后，如果失败，我改变当前目录到声音目录（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

注：空间的名称我也得到了一个新的方法：Filecopy sMusicFile replace(sMusicFile," ","%")，然后播放这个新文件

来源

2015-01-01 19:23:23

尝试：

Public Sub Sound2(ByVal File$) 

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

sMusicFile = File 

...

，如果有一个空间，这将用引号括路径，WH对于某些API函数，这是必需的。

来源

2015-01-02 09:43:20

谢谢，通常这应该工作，但经过一次尝试，我不... –

去老派...想DOS。
例如：
“C：\太长\长目录\ File.mp3”
成为
“C：\ WayToo〜1 \隆迪〜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”或更高，取决于有多少个类似命名的目录或文件名。

我发现这是令人难以置信的是，35年前发布了dos，而VBA程序员仍然不得不处理目录中的这个恐龙问题！

来源

2017-01-17 07:23:30

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

它将您的代码与来自osknows的代码合并到Get full path with Unicode file name中，带有来自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

来源

2017-02-11 21:25:48 gordon613

回答

相关问题