Play any audio file using VBA Excel

前端 未结 5 1586
独厮守ぢ
独厮守ぢ 2021-01-26 20:52

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

so I have to revert

相关标签:
5条回答
  • 2021-01-26 21:31

    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.

    0 讨论(0)
  • 2021-01-26 21:32

    The function converts long full filename to 8.3 short format.

    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
    

    Try it.

    0 讨论(0)
  • 2021-01-26 21:33

    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 name with the idea from Jared above...

    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
    
    0 讨论(0)
  • 2021-01-26 21:41

    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!

    0 讨论(0)
  • 2021-01-26 21:47

    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 as would not be a good solution) :

    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

    0 讨论(0)
提交回复
热议问题