|
|||||||||
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 trayWith 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. 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
|
|||||||||
|
|||||||||