This code, I believe finds all CD letters.
Code: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 Private Sub Command1_Click() Dim tmp As Integer Dim tmpStr As String Dim Drives As String Dim CDsCount As Integer Dim CDsLetters As String 'init Drives to 255 spaces Drives = Space(255) 'get drives, Drives var will look like ' A:\<NULL>C:\<NULL>D:\<NULL>E:\<NULL><NULL> 'ret& is the new length of Drives ret& = GetLogicalDriveStrings(Len(Drives), Drives) For tmp = 1 To ret& Step 4 'get a drive root directory (like "C:\") tmpStr = Mid(Drives, tmp, 3) 'if drive is a CD If GetDriveType(tmpStr) = DRIVE_CDROM Then CDsCount = CDsCount + 1 CDsLetters = CDsLetters & Left(tmpStr, 1) & " " End If Next tmp 'display results If CDsCount Then MsgBox "Number of CDs Available: " & CDsCount & " - CDs Letters: " & UCase(CDsLetters) Else MsgBox "No CDs Available" End If End Sub




Reply With Quote