Open/Close CD Drive using VBA

revilo

revilo

New member
Joined
Sep 30, 2011
Messages
22
Reaction score
0
Points
0
Can you use VBA to open and close the CD Drive?
 
Thanks very much Simon, but, can i bother you to PDF the page and attach it here for me please? The internet policies here are pretty strict, and i cannot access that website.

Your help is appreciated.
 
There aren't any restrictions accessing that site, i work at a large corporate with a very strict firewall and can access it and all content, its a forum run on exactly the same software as this.
 
Well, I obviously don't work at the same place as you then! ;) All URLs are on the blacklist unless they are whitelisted, if you can see what i mean (and it takes quite a while to get a site whitelisted). But anyway, maybe i can get it some other way.
 
I wonder who got my site whitelisted? :confused2: (Tell them they should be adding Simon's too.)

Here's another version of the CD code too...

Code: 
Private Declare Sub SendStringA Lib "winmm.dll" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long)

Sub OpenCDTray()
    SendStringA "Set CDAudio Door Open", 0&, 0, 0
End Sub

Sub CloseCDTray()
   SendStringA "Set CDAudio Door Closed", 0&, 0, 0
End Sub

Simon's version is nicer though. ;)
 
Ken Puls said:
Simon's version is nicer though. ;)
Click to expand...

:nod: I managed to get hold of it :D

Any tips on making it work with 64 bit? i get "The code in this project must be updated for use on 64-bit systems. Please review and update Declare Statements and then mark them with the PtrSafe attribute" :confused2:
 
Win 7 Pro 6.1.7601 64-Bit
Office 2010
 
Right, but is your Office 32 or 64 bit. I'm guessing 32bit, but just want to be sure.

I have to run out, but I'll look at this one later tonight my time. :)
 
I tried to check that, but couldnt find it. it came preinstalled. How do i check? (Please excuse my ignorance :))
 
Okay, let's try this:

Code: 
'API Declarations
#If VBA7 Then
    Private Declare PtrSafe Function mciSendString Lib "winmm.dll" _
            Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
            pstrReturnString As String, ByVal uReturnLength As LongPtr, ByVal _
            wndCallback As LongPtr) As LongPtr
#Else
    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
#End If
'Routines to call APIs
Sub OpenOrShutCDDrive(DoorOpen As Boolean)
    #If VBA7 Then
        Dim lRet As LongPtr
    #Else
        Dim lRet As Long
    #End If
    
    If DoorOpen Then
        lRet = mciSendString("Set CDAudio Door Open", 0&, 0&, 0&)
    Else
        lRet = mciSendString("Set CDAudio door closed", 0&, 0&, 0)
    End If
    'lRet will = 0 upon success, so if you want to make this
    'a function, return true if lret = 0, false otherwise
End Sub
Sub OpenCD()
    OpenOrShutCDDrive (1)
End Sub
Sub CloseCD()
    OpenOrShutCDDrive (0)
End Sub

Just for reference, I'm converting this so that it will work in either the 32bit or 64bit versions of Excel. Only issue is that I don't have either a CD drive in my laptop, or the 64bit version of Excel running, so I can't test.

Give it a go, and let me know what happens. :)
 
Ken Puls said:
Give it a go, and let me know what happens. :)
Click to expand...

Verdict: Perfect!:becky:

Hmm, thats got me thinking. Is it hard to turn each piece of the code into a .vbs? :flypig:
 
Strictly there's only one LongPtr there:
Code: 
[FONT=monospace]'API Declarations[/FONT]
#If VBA7 Then    Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As LongPtr) As Long
 
Thanks for that JoePublic. My experience converting API calls to 64 bit is pretty limited, and I figured it best to err on the side of caution. :)

Revilo, yes, it would be possible to turn it into a .vbs script. Again, my experience doing it is not great, and I've never done it with 64bit conversions yet.
 
To the best of my knowledge, you cannot use Windows API calls from VB script.
 
Hmmm... you may be right... I took a look around, and it seems that most people are using a Windows Media Player library to accomplish the goal.

Revilo, I don't have a CDRom in my laptop. Try creating a new file in Notepad, copying this inside, and saving it as a cdrom.vbs file. Double click to see if it goes or not...
Code: 
Set oWMP = CreateObject("WMPlayer.OCX.7" ) 
Set colCDROMs = oWMP.cdromCollection 
if colCDROMs.Count >= 1 then  colCDROMs.Item(1).Eject
 
I believe the warning is only issued on 64-bit Office versions.

You can just add "PtrSafe" to the Declare and the code will compile - that doesn't mean it will work properly, though! I'm not familiar with SendStringA but, looking at it, I would guess that hwndCallBack needs to be declared as a LongLong, although, as it isn't actually being used, you could probably get away with not changing it for this particular usage.

Sorry - ignore me! For some reason I was only seeing part of the thread and didn't know that all had been answered - when I posted it showed me everything.
 
Last edited:
You must log in or register to reply here.
Back
Top