Avatar of Flora Edwards
Flora Edwards
Flag 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

VBAVB Script

Avatar of undefined
Last Comment
Bill Prew

8/22/2022 - Mon
Bill Prew

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

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.

Bill Prew

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.

This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
Flora Edwards

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

Flora Edwards

thanks Bill.

tested it with the new one and it produced the same error.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Bill Prew

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.

Flora Edwards

thank you Bill.
much appreciated.
Flora Edwards

Hi Bill,

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

Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
Bill Prew

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

Flora Edwards

thanks Bill
Bill Prew

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Flora Edwards

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.

Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Bill Prew

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:

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"
Bill Prew

Make any progress on this?

Flora Edwards

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.
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
Bill Prew

Very welcome.