VBA : exemple de code pour déterminer la lettre de lecteur CD-ROM

  ' **********************************************************************
   '
   ' FUNCTION:
   '    GetFirstCdRomDriveLetter()
   '
   ' PURPOSE:
   '    Finds the first CD-ROM device and then returns its drive letter.
   '
   ' ARGUMENTS:
   '    None
   '
   ' RETURNS:
   '    A string that represents the first CD-ROM drive letter. If the
   '    function fails for any reason, it returns vbNullString.
   '
   ' **********************************************************************
   Declare Function GetDriveType Lib "kernel32" Alias _
      "GetDriveTypeA" (ByVal nDrive As String) As Long

   Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
      "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
      ByVal lpBuffer As String) As Long

   Public Const DRIVE_CDROM As Long = 5

   Function GetFirstCdRomDriveLetter() As String

      ' Declare variables.
      Dim lDriveType As Long
      Dim strDrive As String
      Dim lStart As Long: lStart = 1

      ' Create a string to hold the logical drives.
      Dim strDrives As String
      strDrives = Space(150)

      ' Get the logial drives on the system.
      ' If the function fails it returns zero.
      Dim lRetVal As Long
      lRetVal = GetLogicalDriveStrings(150, strDrives)

      ' Check to see if GetLogicalDriveStrings() worked.
      If lRetVal = 0 Then

         ' Get GetLogicalDriveStrings() failed.
         GetFirstCdRomDriveLetter = vbNullString
         Exit Function
      End If

      ' Get the string that represents the first drive.
      strDrive = Mid(strDrives, lStart, 3)

      Do

         ' Test the first drive.
         lDriveType = GetDriveType(strDrive)

         ' Check if the drive type is a CD-ROM.
         If lDriveType = DRIVE_CDROM Then

            ' Found the first CD-ROM drive on the system.
            GetFirstCdRomDriveLetter = strDrive
            Exit Function
         End If

         ' Increment lStart to next drive in the string.
         lStart = lStart + 4

         ' Get the string that represents the first drive.
         strDrive = Mid(strDrives, lStart, 3)

      Loop While (Mid(strDrives, lStart, 1) <> vbNullChar)

   End Function
				

   Sub Main

      Dim strDriveLetter as String

      ' Call the GetFirstCdRomDriveLetter() and store the
      ' return value in strDriveLetter.
      strDriveLetter = GetFirstCdRomDriveLetter()

      ' Display the drive letter in a message box.
      MsgBox strDriveLetter

   End Sub