ERLANDSEN DATA CONSULTING Excel & VBA Tips   Informasjon på norsk / Information in Norwegian

These pages are no longer updated and are only available for archive purposes.

Click here to visit the pages with updated information.

Open and close the CD/DVD tray

With the macros below you are able to open and close the default CD/DVD tray.

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

Sub OpenDefaultDiscTray()
    mciSendStringA "Set CDAudio Door Open", 0&, 0, 0
End Sub

Sub CloseDefaultDiscTray()
    mciSendStringA "Set CDAudio Door Closed", 0&, 0, 0
End Sub

You can use the macro below to open a specific CD/DVD tray if you know the drive letter.
You will need a third party tool if you want to close the tray by code.

Sub OpenDiscTray(strDriveLetter As String)
' this will open the CD/DVD tray for the given drive letter
' e.g.: OpenDiscTray "F"
Dim Shell As Object, MyComputer As Object
    Set Shell = CreateObject("Shell.Application")
    Set MyComputer = Shell.Namespace(17)
    On Error Resume Next
    MyComputer.ParseName(strDriveLetter & ":\").InvokeVerb ("e&ject")
    On Error GoTo 0
    Set MyComputer = Nothing
    Set Shell = Nothing
End Sub

You can use the macro below to determine if a drive is ready, e.g. when a disc is present in a CD/DVD drive.

Function DriveIsReady(strDriveLetter As String) As Boolean
' returns True if a drive is ready, e.g. a disc is present in a CD/DVD drive
Dim fso As Scripting.FileSystemObject, drv As Scripting.Drive
Dim Shell As Object, MyComputer As Object
    Set fso = New FileSystemObject
    On Error Resume Next
    Set drv = fso.GetDrive(strDriveLetter)
    On Error GoTo 0
    If Not drv Is Nothing Then
        DriveIsReady = drv.IsReady
        Set drv = Nothing
    End If
    Set fso = Nothing
End Function

Here is an example macro that uses the last two example macros:

Sub TestDiscTrays()
Dim i As Integer
    OpenDiscTray "G"
    i = MsgBox("Click OK when you have inserted a new disc.", vbOKCancel)
    If i = vbCancel Then Exit Sub ' user aborted
    If Not DriveIsReady("G") Then
        MsgBox "Disc not inserted, aborting...", vbExclamation
        Exit Sub
    End If
    ' continue your tasks here, e.g. like this
    'FileCopy "G:\somefile.txt", "C:\"
End Sub


Document last updated 2005-09-26 12:59:36      Printerfriendly version

User comments:
Ole P. from Norway wrote (2005-09-26 13:05:48 CET):
Re: Brilliant...!
See the updated example above.
If you need to close a specific tray you will need to find some third party tools available on the Internet.
Andrew from NE England wrote (2005-09-25 21:16:41 CET):
That opens/Closes 1 Drive(D)..!

How do I open/Close the Other(E)...?
(Just In case I need Ice, He He he)

godtfred from Europe wrote (2005-02-22 19:49:39 CET):
Open and close CD-ROM
Very neet!! Thanks for making it available for us!


Erlandsen Data Consulting   
Excel & VBA Tips   Copyright ©1999-2024    Ole P. Erlandsen   All rights reserved
E-mail Contact Address