Lecteur cd

'******************************************************
'* Ouvrir les lecteurs/graveurs de CD/DVD             *
'* DOCmémo - www.docmemo.com                          *
'******************************************************
'* Personnalisation :                                 *
'* Pour limiter l'action du script à un seul lecteur, *
'* modifiez l'instruction                             *
'* For intDriveLetter = Asc("A") To Asc("Z")          *
'* Par exemple, pour limiter au lecteur E :           *
'* For intDriveLetter = Asc("E") To Asc("E")          *
'******************************************************
Dim ts 
Dim strDriveLetter 
Dim intDriveLetter 
Dim fs 'As Scripting.FileSystemObject 
Const CDROM = 4 
On Error Resume Next 
Set fs = CreateObject("Scripting.FileSystemObject") 
' Detection des lecteurs de CD 
strDriveLetter = "" 
For intDriveLetter = Asc("A") To Asc("Z") 'Limitez aux lecteurs souhaités
	Err.Clear 
	If fs.GetDrive(Chr(intDriveLetter)).DriveType = CDROM Then 
		If Err.Number = 0 Then 
			strDriveLetter = Chr(intDriveLetter) 
        Exit For 
		End If 
	End If 
Next 
   
' Ouvrir tous les lecteurs 
Set owmp = CreateObject("WMPlayer.OCX.7") 
Set colCDROMs = owmp.cdromCollection 
For d = 0 To colCDROMs.Count - 1 
	colCDROMs.Item(d).Eject 
Next 
   
' Fermer tous les lecteurs que l'on vient d'ouvrir 
A1 = MsgBox("Cliquez sur OK pour fermer les lecteurs " & strDriveLetter, 0 + 64, "Infos") 
For d = 0 to colCDROMs.Count -1 
	colCDROMs.Item(d).Eject 
Next 
  
Set owmp = Nothing 
Set colCDROMs = Nothing 
wscript.quit