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

Flora EdwardsMedicineAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Bill PrewIT / Software Engineering ConsultantCommented:
Just curious, what's your motivation for running this from VBA versus stand alone?

Flora EdwardsMedicineAuthor Commented:
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 PrewIT / Software Engineering ConsultantCommented:
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.

Announcing the Winners!

The results are in for the 15th Annual Expert Awards! Congratulations to the winners, and thank you to everyone who participated in the nominations. We are so grateful for the valuable contributions experts make on a daily basis. Click to read more about this year’s recipients!

Flora EdwardsMedicineAuthor Commented:
thanks so much Bill.

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

many thanks.
byundtMechanical EngineerCommented:
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 EdwardsMedicineAuthor Commented:
thanks Bill.

tested it with the new one and it produced the same error.
Bill PrewIT / Software Engineering ConsultantCommented:
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 EdwardsMedicineAuthor Commented:
thank you Bill.
much appreciated.
Flora EdwardsMedicineAuthor Commented:
Hi Bill,

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

Bill PrewIT / Software Engineering ConsultantCommented:
Just returned from holiday, will be looking at this in the next couple of days...

Flora EdwardsMedicineAuthor Commented:
thanks Bill
Bill PrewIT / Software Engineering ConsultantCommented:
Okay, sorry about the delay, you can't imagine how long it took me to get this working as an HTA, longer than I would have liked, but to be fair there wasn't too much info available so a bit of trial and error.  This could be enhanced, but I wanted to get at least this first version to you, which seems to work here, and have you test it there.

Attached is a small ZIP file which contains the HTA file, and then a small WAV file of an alarm sound you could use.  I had to rename them to TXT files since Experts Exchange doesn't like their real extensions in an attachment, but just rename the files as follows:

EE29007038.txt  -->  EE29007038.hta
siren.txt  -->  siren.wav

Naturally you can use other sounds if you want, just have to adjust the code to reference then, or name then the same as this one.  Place the WAV and the HTA in the same folder and then launch the HTA either by double clicking it in File Explorer, or typing it's full name at a command prompt.  Ultimately you would probably create a shortcut to the HTA file and place that on your desktop for easy execution when you want it.

When the HTA loads it displays a very simple window with a space for messages to be shown, and an Exit button.  With the HTA running insert a USB drive, wait a few seconds until Windows has loaded it and such, and then remove it.  You should get a message in the text area, and the alarm sound should sound.

Let's see if that works for you, hopefully it will.  And if it does how close it is to what you wanted...


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Flora EdwardsMedicineAuthor Commented:
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.

Bill PrewIT / Software Engineering ConsultantCommented:
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 PrewIT / Software Engineering ConsultantCommented:
Make any progress on this?

Flora EdwardsMedicineAuthor Commented:
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.
Bill PrewIT / Software Engineering ConsultantCommented:
Very welcome.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.