We help IT Professionals succeed at work.

modifying VBScript to VBA

Flora Edwards
on
379 Views
Last Modified: 2017-04-11
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

Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
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...
CERTIFIED EXPERT
Expert of the Year 2019
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
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
CERTIFIED EXPERT
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...
CERTIFIED EXPERT
Expert of the Year 2019
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...
CERTIFIED EXPERT
Expert of the Year 2019
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...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION
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...
CERTIFIED EXPERT
Expert of the Year 2019
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...
CERTIFIED EXPERT
Expert of the Year 2019
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...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Very welcome.