Open and close the CD/DVD tray
2005-09-26 Other 0 199
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 SubYou 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 SubYou 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 FunctionHere 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