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