Open/Close CD Drive using VBA

The index actually starts at 0 so you need:
Code: 
If colCDROMs.Count >= 1 Then colCDROMs.Item(0).Eject
as the last line.
 
Thats great. Works perfectly! Can you guess my next question? How to make it pull back in with vbs? I tried changing the "0" to "1", but it didn't work.
 
This is going to seem strange, but can you try this?

Code: 
Set oWMP = CreateObject("WMPlayer.OCX.7" ) 
Set colCDROMs = oWMP.cdromCollection 
colCDROMs.Item(0).Eject
colCDROMs.Item(0).Eject

Let me know what happens...
 
Weird, but sort of logical! It works! Thanks! i really appreciate your help!

by the way, just so that you know, my CD tray is a little hard to get to (my computer is under my desk), and i have put a shortcut to these to files in %systemroot%\system32 called 1 and 2.
Now i can Win+R type 1 to open, and 2 to close the CD Drive.

Lazy, aren't I?:ranger:
 
Laziness is the father of invention. :)
 
LOL! Ain't it though? :)

Revilo, I was going to ask if you were planning to use this for Good or Evil, but never quite got there. (This routine is also used for the practical joke of opening the CD tray and demanding coffee when the spreadsheet is opened before say... 6AM or something.)
 
I have seen that spreadsheet, and i was thinking of using it in a practical sort of a way. That said, the CD opening .vbs might be fun in someones startup folder... It works on a laptop as well, but you obviously can't make it close the drawer...

Change the attachments extension to .vbs and test it yourself if you want. (You can probably build it yourself, but i decided to make it easy for you :))
 

Attachments

  • CD Open.txt
    137 bytes · Views: 58
Ken Puls said:
Code: 
    Private Declare Function mciSendString Lib "winmm.dll" _
            Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
            pstrReturnString As String, ByVal uReturnLength As Long, ByVal _
            wndCallback As Long) As Long
Click to expand...
I don't know why this code can't run in my Office 2010 (Windows 7 Sp1 64bit).
I have a code for Office 32bit, and I don't know how to convert to 64bit :(

Code: 
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Can you help me? Thanks!
 
64 bit office addresses memory differently, and the values in 64bit are too large to be held by a Long data type.

I believe this should convert for you (untested):

Code: 
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As LongPtr)
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As LongPtr
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As LongPtr
Private Declare Function GetActiveWindow Lib "user32" () As LongPtr
Public Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As LongPtr, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUncheckedPtr As Long, ByVal hBitmapCheckedPtr As Long) As LongPtr

More info on converting to 64 bit compliant calls can be found here: http://www.jkp-ads.com/articles/apideclarations.asp
 
It doen't work for my Office. I have to read the link you give me. Thanks.
 
You must log in or register to reply here.
Back
Top