troubleshooting Question

modifying VBScript to VBA

Avatar of Flora Edwards
Flora EdwardsFlag for Sweden asked on
VB ScriptVBA
17 Comments1 Solution423 ViewsLast Modified:
I have this code below helped by Bill.

i modified it a bit to work with VBA. now it works. except that line Set objWMP = CreateObject("WMPlayer.OCX")  throws error of Run-time error 429, ActiveX componenet cannot create object

any idea how to fix this?


Option Explicit
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub test()
Const RemovableDisk = 2
Const AlarmSound = "C:\Users\flora\Downloads\New folder\siren.wav"
Const AlarmVolume = 100 ' 0 to 100

' Global variables
Dim objWMI
Dim colEvents
Dim objEvent

' Create WMI object
Set objWMI = GetObject("winmgmts:\\.\root\cimv2")

' Hook events related to Win32_LogicalDisk
Set colEvents = objWMI.ExecNotificationQuery("Select * From __InstanceOperationEvent Within 1 Where TargetInstance isa 'Win32_LogicalDisk'")

' Loop endlessly (ctrl-C to exit program from console)
Do While True
    ' Get next event
    Set objEvent = colEvents.NextEvent

    ' Only interested in removable disk events
    If objEvent.TargetInstance.DriveType = RemovableDisk Then

        ' See what even this is and process if desired
        Select Case objEvent.Path_.Class

            ' Drive removed evemt is what we want
            Case "__InstanceDeletionEvent"

                ' Display message indicating drive removed and play alarm sound
                  'WScript.Echo
             MsgBox "Drive " & objEvent.TargetInstance.DeviceId & " has been removed."
                Call PlaySound(AlarmSound, AlarmVolume)

        End Select

    End If

Loop
End Sub
' Constants



' Play a sound file using WMPLAYER object
Sub PlaySound(strFile, intVolume)
    ' Local variables
    Dim objWMP
    Dim intSaveVolume

    ' Create player object
    Set objWMP = CreateObject("WMPlayer.OCX")

    ' Save current volume if we are using our own level
    If intVolume >= 0 And intVolume <= 100 Then
        intSaveVolume = objWMP.Settings.Volume
        objWMP.Settings.Volume = intVolume
    End If

    ' Set path to sound file and play it
    objWMP.URL = strFile
    objWMP.Controls.Play

    ' Wait for it to finish playing
    While objWMP.PlayState <> 1 ' Stopped
      Sleep 100
    Wend

    ' Restore original player volume if we changed it
    If intVolume >= 0 And intVolume <= 100 Then
        objWMP.Settings.Volume = intSaveVolume
    End If

    ' Tear down player object
    objWMP.Close
    Set objWMP = Nothing
End Sub
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 1 Answer and 17 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 17 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros