Link to home
Start Free TrialLog in
Avatar of Flora Edwards
Flora EdwardsFlag for Sweden

asked on

modifying VBScript to VBA

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
             MsgBox "Drive " & objEvent.TargetInstance.DeviceId & " has been removed."
                Call PlaySound(AlarmSound, AlarmVolume)

        End Select

    End If

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

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

    ' 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
    Set objWMP = Nothing
End Sub

Open in new window

Avatar of Bill Prew
Bill Prew

Just curious, what's your motivation for running this from VBA versus stand alone?

Avatar of Flora Edwards


when i run your code in my prviate machine with admin rights, it worked, when i run it in my office machine with limited user. i get the following error when running the vbs.  so in VBA env i do not face that. so instead i am using Excel to avoid the block of vbs.

User generated image
Okay, got it. I wonder if Powershell is locked down for you?

Also, you might search for a simple "Hello world" HTA example file online and grab that and see if you can run the HTA file without error.  If so it would be easy to use that.  I'd send you a test file but I'm on mobile at the moment.

thanks so much Bill.

yes, powershell is open and also i can run .hta files.   i prefer hta over pwershell.

many thanks.
Does the following statement work in your VBA?
Dim objWMP As Object
Set objWMP = CreateObject("new:{6BF52A52-394A-11d3-B153-00C04F79FAA6}")

Open in new window

thanks Bill.

tested it with the new one and it produced the same error.
Tried to build a HTA for this, getting close but still having some snags.  Running low on time, but interested in pushing forward when I can.

thank you Bill.
much appreciated.
Hi Bill,

i understand you are busy, i was wondering if you would have any chance to help me with this hta?

Just returned from holiday, will be looking at this in the next couple of days...

thanks Bill
Avatar of Bill Prew
Bill Prew

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
thank you very much Bill.

it is almost there. it worked, except that it fires an error on the playing the alarm.

i got the below error when USB was removed.

User generated image
My first suspicion would be that on your system WAV files are not associated with Windows Media Player.  A few things to do.  First you can make the WMP embded object visible in the window by the following.

<embed id="Alarm" name="Alarm" src=".\siren.wav" loop="false" hidden="false" autostart="false">

Then you should see the WMP control as in:

User generated image
You can also check the WAV file extension and see what is handling it via the ASSOC and FTYPE commands, here is what mine looks like.

[c:\]assoc .wav


[c:\]ftype WMP11.AssocFile.WAV

WMP11.AssocFile.WAV="%ProgramFiles(x86)%\Windows Media Player\wmplayer.exe" /Open "%L"
Make any progress on this?

thank you very much Bill.  you found the issue. my machine in domain envi  did not have windows media player.  your solution is perfect and it works.  

again thanks sooooo much.
Very welcome.