如何在Excel VBA中将Beep生成的声音保存为MP3、WMA等音频文件

我现在有一段依赖Beep函数的VBA代码，想要把它生成的声音保存成MP3、WMA这类常见的音频格式，恳请各位大佬帮忙支招！

我目前的代码如下： #

模块代码：

Public Declare Function Beep Lib "kernel32" _
(ByVal dwFreq As Long, _
ByVal dwDuration As Long) As Long

主代码：

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim LR As Long
Set ws = ActiveSheet
LR = ws.Range("A" & Rows.Count).End(xlUp).Row
tempo = 500 '0.5秒
For I = 1 To LR
HB = ws.Range("B" & I).Value
L = ws.Range("C" & I).Value
Beep HB, L * tempo
Next I
End Sub

解决方案说明 #

首先得明确：Beep函数只是调用系统主板的蜂鸣器发声，它并没有生成可保存的音频数据流，所以没法直接把Beep的声音存成文件。我们需要换一种方式，先生成标准的波形音频（WAV），再转换成MP3/WMA格式。

下面提供两种可行的VBA实现思路：

方法1：使用MCI命令生成WAV文件，再转成MP3/WMA

MCI（Media Control Interface）是Windows自带的多媒体控制接口，可以直接生成WAV音频，之后我们可以借助Windows自带的音频转换工具完成格式转换。

步骤1：生成WAV文件的VBA代码

替换原来的Beep逻辑，用MCI生成可保存的WAV：

' 先声明需要的API
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
    (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
    ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim LR As Long, i As Long
    Dim freq As Long, duration As Long
    Dim wavPath As String
    Dim mciCmd As String
    
    Set ws = ActiveSheet
    LR = ws.Range("A" & Rows.Count).End(xlUp).Row
    tempo = 500 ' 基础时长单位（毫秒）
    wavPath = ThisWorkbook.Path & "\output.wav" ' 生成的WAV路径
    
    ' 初始化MCI，创建波形音频文件
    mciCmd = "open new type waveaudio alias mysound"
    mciSendString mciCmd, vbNullString, 0, 0
    mciCmd = "set mysound time format ms"
    mciSendString mciCmd, vbNullString, 0, 0
    
    ' 循环添加每个音符
    For i = 1 To LR
        freq = ws.Range("B" & i).Value
        duration = ws.Range("C" & i).Value * tempo
        ' 设置音频参数（单声道、44.1kHz采样率、16位深度）
        mciCmd = "set mysound format tag pcm channels 1 samplespersec 44100 bitspersample 16"
        mciSendString mciCmd, vbNullString, 0, 0
        ' 开始录制当前音符
        mciCmd = "record mysound"
        mciSendString mciCmd, vbNullString, 0, 0
        ' 同步用Beep发声（可选，实时听到声音）
        Beep freq, duration
        ' 停止录制当前音符
        mciCmd = "stop mysound"
        mciSendString mciCmd, vbNullString, 0, 0
    Next i
    
    ' 保存WAV文件并关闭MCI资源
    mciCmd = "save mysound """ & wavPath & """"
    mciSendString mciCmd, vbNullString, 0, 0
    mciCmd = "close mysound"
    mciSendString mciCmd, vbNullString, 0, 0
    
    MsgBox "WAV文件已生成：" & wavPath
    ' 调用转换函数生成MP3
    ConvertWavToMp3 wavPath, Replace(wavPath, ".wav", ".mp3")
End Sub

步骤2：将WAV转成MP3/WMA

Windows自带的录音机支持命令行转换，添加这段代码即可完成格式转换：

Private Sub ConvertWavToMp3(wavPath As String, mp3Path As String)
    Dim shellCmd As String
    ' Windows 10及以上版本支持该命令行参数
    shellCmd = "soundrecorder /file """ & wavPath & """ /convert """ & mp3Path & """"
    Shell shellCmd, vbHide
    MsgBox "MP3文件已生成：" & mp3Path
End Sub

如果需要转换为WMA，只需把输出路径的后缀改成.wma即可。

方法2：直接生成波形数据并保存为WAV，再用第三方工具转换

如果你需要更精细的音频参数控制，可以直接生成WAV文件的二进制数据，兼容性更强：

Private Sub GenerateWavDirectly()
    Dim ws As Worksheet
    Dim LR As Long, i As Long
    Dim freq As Long, duration As Long
    Dim wavFile As Integer
    Dim sampleRate As Long, bitsPerSample As Integer, channels As Integer
    Dim dataSize As Long, fileSize As Long
    Dim totalSamples As Long, sample As Integer
    Dim t As Double, angle As Double
    
    Set ws = ActiveSheet
    LR = ws.Range("A" & Rows.Count).End(xlUp).Row
    tempo = 500
    sampleRate = 44100 ' 采样率
    bitsPerSample = 16 ' 位深度
    channels = 1 ' 单声道
    
    ' 计算总采样数
    totalSamples = 0
    For i = 1 To LR
        totalSamples = totalSamples + (ws.Range("C" & i).Value * tempo / 1000) * sampleRate
    Next i
    dataSize = totalSamples * channels * (bitsPerSample / 8)
    fileSize = 36 + dataSize ' WAV文件头大小+数据大小
    
    ' 创建并写入WAV文件
    wavFile = FreeFile
    Open ThisWorkbook.Path & "\direct_output.wav" For Binary As #wavFile
        ' 写入WAV文件头
        Put #wavFile, , "RIFF"
        Put #wavFile, , fileSize
        Put #wavFile, , "WAVE"
        Put #wavFile, , "fmt "
        Put #wavFile, , 16 ' PCM格式大小
        Put #wavFile, , 1& ' PCM格式
        Put #wavFile, , channels&
        Put #wavFile, , sampleRate&
        Put #wavFile, , sampleRate * channels * (bitsPerSample / 8)&
        Put #wavFile, , channels * (bitsPerSample / 8)&
        Put #wavFile, , bitsPerSample%
        Put #wavFile, , "data"
        Put #wavFile, , dataSize
        
        ' 写入音频数据（生成正弦波）
        For i = 1 To LR
            freq = ws.Range("B" & i).Value
            duration = ws.Range("C" & i).Value * tempo
            Dim sampleCount As Long
            sampleCount = (duration / 1000) * sampleRate
            For t = 0 To sampleCount - 1
                angle = 2 * 3.14159265 * freq * t / sampleRate
                sample = 32767 * Sin(angle) ' 生成正弦波样本
                Put #wavFile, , sample%
            Next t
        Next i
    Close #wavFile
    
    MsgBox "WAV文件已直接生成：" & ThisWorkbook.Path & "\direct_output.wav"
End Sub

生成WAV后，可通过Shell命令调用ffmpeg等第三方工具转换为MP3/WMA：

Private Sub ConvertWithFfmpeg(wavPath As String, mp3Path As String)
    Dim ffmpegPath As String
    ffmpegPath = "C:\ffmpeg\bin\ffmpeg.exe" ' 替换成你的ffmpeg实际路径
    Shell """" & ffmpegPath & """ -i """ & wavPath & """ """ & mp3Path & """", vbHide
    MsgBox "MP3转换完成！"
End Sub

注意事项 #

• 方法1中的MCI命令可能需要管理员权限，部分系统可能需要调整音频录制权限
• 方法2生成的是标准PCM波形，几乎所有音频播放器都能识别
• 如果转换失败，检查文件路径是否包含中文或特殊字符

内容的提问来源于stack exchange，提问作者wee cheng yong