Option Explicit 
Private Declare Function BeepA Lib "kernel32" Alias "Beep" ( _ 
ByVal Frequency As Long, ByVal Duration As Long) As Long 
 
Public Sub CustomBeep() 
    Dim intFrq As Integer 
    Const lngStep_c As Long = 150 
    Const lngMillisecond_c As Long = 1 
    Const lngUprBnd_c As Long = 6000 
    Const lngLwrBnd_c As Long = 100 
    For intFrq = lngLwrBnd_c To lngUprBnd_c Step lngStep_c 
        PCSpeakerSound intFrq, lngMillisecond_c 
    Next 
    For intFrq = (lngUprBnd_c - lngStep_c) To (lngLwrBnd_c + lngStep_c) Step -lngStep_c 
        PCSpeakerSound intFrq, lngMillisecond_c 
    Next 
End Sub 
 
Public Sub PCSpeakerBeep() 
     'Note: This function is asynchronous.
    On Error Resume Next 
    Const strCommand_c As String = "cmd /c echo " 
    Const lngBellChr_c As Long = 7 
    VBA.Shell strCommand_c & VBA.Chr$(lngBellChr_c), vbHide 
End Sub 
 
Public Sub PCSpeakerSound(Frequency As Integer, Duration As Long) 
     'Purpose:   Sends as sound to the PC speaker
     'Input  :   -Frequency: Specifies the frequency (in hertz)
     '            of the sound to be sent to the speaker. Only
     '            accepts values from 37 through 32,767.
     '           -Duration:  Length of the sound in milliseconds.
    Const lngValidLwrBnd_c As Long = 37 
    Const lngValidUprBnd_c As Long = 32767 
    Const strError_c As String = "Invalid value for parameter" & _ 
    """Frequency"". Values must " & _ 
    "be 37 through 32,767." 
    If Frequency < lngValidLwrBnd_c Then 
        VBA.Err.Raise vbObjectError, VBA.Err.Source, strError_c 
    ElseIf Frequency > lngValidUprBnd_c Then 
        VBA.Err.Raise vbObjectError, VBA.Err.Source, strError_c 
    Else 
        If BeepA(Frequency, Duration) = False Then 
            VBA.Err.Raise vbObjectError, "PCSpeakerSound", "Speaker not found." 
        End If 
    End If 
End Sub