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