Write a WAV file in VBA

Option Explicit

'Write a stereo WAV file with arbitrary sample rate, 16-bit signed LPCM
'Note that since VBA does not support unsigned long (32 bit) values at all, some of the limits
'for our WAV files are half what the file format supports, but still much longer than we would
'ever realistically use. VBA writes all binary values to disk as little endian, which is convenient
'as this is what a WAV file requires. Except for the 4-byte ASCII values, which we write one
'byte/char at a time as big endian (or "no-endian")
Sub write_wav_file(ByVal filename As String, samplesL() As Double, samplesR() As Double)

    Dim fileNumber As Integer
    fileNumber = FreeFile
    Open (ActiveWorkbook.Path & "\" & filename) For Binary Access Write As #fileNumber

    Dim fileSize As Long, dataSizeL As Long, dataSizeR As Long
    dataSizeL = 2 * (UBound(samplesL) - (LBound(samplesL) - 1)) '1 sample = 2 bytes
    dataSizeR = 2 * (UBound(samplesR) - (LBound(samplesR) - 1))
    fileSize = dataSizeL + dataSizeR + 44 '44 is the magic number sum of all metadata bytes

    '===========
    'RIFF HEADER
    '===========
    'ChunkID: The letters "RIFF" in ASCII, 0x52 49 46 46 big-endian
    Put #fileNumber, , CByte(&H52)
    Put #fileNumber, , CByte(&H49)
    Put #fileNumber, , CByte(&H46)
    Put #fileNumber, , CByte(&H46) '4

    'ChunkSize: little-endian, 4 bytes. Size of the entire file in bytes,
    'minus 8 bytes for the first 4 bytes and these 4 bytes
    Put #fileNumber, , CLng(fileSize - 8) '8

    'Format: The letters "WAVE" in ASCII, 0x57 41 56 45 big-endian
    Put #fileNumber, , CByte(&H57)
    Put #fileNumber, , CByte(&H41)
    Put #fileNumber, , CByte(&H56)
    Put #fileNumber, , CByte(&H45) '12

    '===========
    'SUB CHUNK 1
    '===========
    'Subchunk1ID: The letters "fmt " (with space!) in ASCII, 0x66 6D 74 20 big-endian
    Put #fileNumber, , CByte(&H66)
    Put #fileNumber, , CByte(&H6D)
    Put #fileNumber, , CByte(&H74)
    Put #fileNumber, , CByte(&H20) '16

    'Subchunk1Size: little endian, 4 bytes. Size of sub chunk 1, not including the first 8 bytes
    'It's always 16 for our WAV file
    Put #fileNumber, , CLng(16) '20

    'AudioFormat: little endian. 2 bytes, 0x01 for PCM
    Put #fileNumber, , CInt(1) '22

    'NumChannels: little endian. 2 bytes, 0x02 for stereo
    Put #fileNumber, , CInt(2) '24

    'SampleRate: little endian, 4 bytes
    Put #fileNumber, , CLng(SAMPLERATE) '28

    'ByteRate: little endian, 4 bytes. SampleRate * NumChannels * BytesPerSample
    Put #fileNumber, , CLng(SAMPLERATE * 4) '32

    'BlockAlign: little endian, 2 bytes. Number of bytes for one sample including all channels
    'NumChannels * BytesPerSample = 4 for us
    Put #fileNumber, , CInt(4) '34

    'BitsPerSample: little endian, 2 bytes. Per channel, so 16 for us
    Put #fileNumber, , CInt(16) '36

    '===========
    'SUB CHUNK 2
    '===========
    'SubChunk2ID: The letters "data" in ASCII, 0x64 61 74 61 big-endian
    Put #fileNumber, , CByte(&H64)
    Put #fileNumber, , CByte(&H61)
    Put #fileNumber, , CByte(&H74)
    Put #fileNumber, , CByte(&H61) '40

    'Subchunk2Size: little endian, 4 bytes. The number of bytes in the data,
    'not including the first 8 bytes of sub chunk 2
    Put #fileNumber, , CLng(dataSizeL + dataSizeR) '44

    'The actual sound data, right channel samples first, then left channel samples
    Dim i As Long
    For i = LBound(samplesL) To UBound(samplesL)
        Put #fileNumber, , double_to_lpcm(samplesL(i))
        Put #fileNumber, , double_to_lpcm(samplesR(i))
    Next i

    Close #fileNumber
End Sub

'Convert a 64-bit double to a 16-bit signed audio sample
'Double audio samples are typically in [-1, 1] which represents -inf db (0) to 0db (+/-1)
'We clip our input double samples to this range otherwise we get wraparound distortion, the
'worst possible distortion
Function double_to_lpcm(sample As Double) As Integer
    If sample > 1 Then sample = 1 Else If sample < (-1) Then sample = (-1)
    sample = sample * CDbl(&H7FFF)
    double_to_lpcm = CInt(sample)
End Function