modifying VBScript to VBA

Flora Edwards
Flora Edwards used Ask the Experts™
on
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

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Bill PrewTest your restores, not your backups...
Top Expert 2016

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

~bp
Flora EdwardsMedicine

Author

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.

2017-03-06-19_48_40-Windows-Script-H.png
Bill PrewTest your restores, not your backups...
Top Expert 2016

Commented:
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.

~bp
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 EdwardsMedicine

Author

Commented:
thanks so much Bill.

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

many thanks.
byundtMechanical Engineer
Most Valuable Expert 2013
Top Expert 2013

Commented:
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 EdwardsMedicine

Author

Commented:
thanks Bill.


tested it with the new one and it produced the same error.
Bill PrewTest your restores, not your backups...
Top Expert 2016

Commented:
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.

~bp
Flora EdwardsMedicine

Author

Commented:
thank you Bill.
much appreciated.
Flora EdwardsMedicine

Author

Commented:
Hi Bill,

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

thanks.
Bill PrewTest your restores, not your backups...
Top Expert 2016

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

~bp
Flora EdwardsMedicine

Author

Commented:
thanks Bill
Test your restores, not your backups...
Top Expert 2016
Commented:
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...

~bp


EE29007038.zip
Flora EdwardsMedicine

Author

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.

2017-04-07-10_43_56-Script-Error.png
Bill PrewTest your restores, not your backups...
Top Expert 2016

Commented:
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:

sshot-111.png
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

.wav=WMP11.AssocFile.WAV

[c:\]ftype WMP11.AssocFile.WAV

WMP11.AssocFile.WAV="%ProgramFiles(x86)%\Windows Media Player\wmplayer.exe" /Open "%L"
Bill PrewTest your restores, not your backups...
Top Expert 2016

Commented:
Make any progress on this?

~bp
Flora EdwardsMedicine

Author

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 PrewTest your restores, not your backups...
Top Expert 2016

Commented:
Very welcome.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial