Option Explicit
'**************************************
' Name: GetCDROMDrives
' Description:Detect the CDROM drives return drive letter(s)
' Author: Joe Johnston storm@the-forest.net

' Returns: CD rom drives "DEF" = D:\ & E:\ & F:\~~  "E" = E:\
'          how many drives can be solved len(GetCDROMDrives)
'
'**************************************
Const DRIVE_CDROM = 5

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Function GetCDROMDrives() As String
    Dim intTmp As Integer, tmpStr As String, strDrives As String ', intCD As Integer
    Dim strDriveLetters As String, ret&
    GetCDROMDrives = "0" '(zero) is the default in case there are no CDROM drives
    
    strDrives = Space(255) 'init strDrives to 255 spaces
    'get drives, strDrives var will look like 'A:\, C:\, D:\, E:\, ..:\
    ret& = GetLogicalDriveStrings(Len(strDrives), strDrives) 'ret& is the new length of strDrives

    For intTmp = 1 To ret& Step 4 ' We want to step over the ":\,"
        tmpStr = Mid(strDrives, intTmp, 3) 'get a drive root directory (like "C:\")

        If GetDriveType(tmpStr) = DRIVE_CDROM Then 'if drive is a CD
           'intCD = intCD + 1
                'If intCD > 1 Then ' If there are more than one CDs lets delimit the output
                '    strDriveLetters = strDriveLetters & ","
                'End If
            strDriveLetters = strDriveLetters & Left(tmpStr, 1)
        End If
    Next intTmp

    'Output the CD rom drives "DEF" = D:\ & E:\ & F:\~~  "E" = E:\
    ' how many drives can be solved len(GetCDROMDrives)
    GetCDROMDrives = UCase(strDriveLetters)

End Function