Este codigo saca todas las unidades disponibles de tu Pc. Le hize una modificacion para que solo muestre lo que pides
Solo ocupa un Boton y un ListBox :
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5 'can be a CD or a DVD
Private Const DRIVE_RAMDISK = 6
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()
'VB4-32 / VB5 / VB6-compatible code
Dim sAllDrives As String
Dim sDrive As String
Dim sDrvType As String
'get the list of all drives
sAllDrives = GetDriveString()
'separate the drive strings and
'retrieve the drive type
Do Until sAllDrives = Chr$(0)
sDrive = StripNulls(sAllDrives)
sDrvType = GetDriveDescription(sDrive)
If sDrvType Like "*CD*" Or sDrvType Like "*DVD*" Then
List1.AddItem sDrive & vbTab & sDrvType
End If
Loop
End Sub
Private Function GetDriveString() As String
'Used by both demos
'returns string of available
'drives each separated by a null
Dim sBuff As String
'possible 26 drives, three characters
'each plus a trailing null for each
'drive letter and a terminating null
'for the string
sBuff = Space$((26 * 4) + 1)
If GetLogicalDriveStrings(Len(sBuff), sBuff) Then
'just trim off the trailing spaces - leave the nulls
GetDriveString = Trim$(sBuff)
End If
End Function
Private Function GetDriveDescription(RootPathName) As String
'Used by both demos
'Passed is the drive to check.
'Returned is the type of drive.
Select Case GetDriveType(RootPathName)
Case 0: GetDriveDescription = "The drive type cannot be determined"
Case 1: GetDriveDescription = "The root directory does not exist"
Case DRIVE_REMOVABLE:
Select Case Left$(RootPathName, 1)
Case "a", "b": GetDriveDescription = "Floppy drive"
Case Else: GetDriveDescription = "Removable drive"
End Select
Case DRIVE_FIXED: GetDriveDescription = "Hard drive; can not be removed"
Case DRIVE_REMOTE: GetDriveDescription = "Remote (network) drive"
Case DRIVE_CDROM: GetDriveDescription = "Optical drive (CD or DVD)"
Case DRIVE_RAMDISK: GetDriveDescription = "RAM disk"
End Select
End Function
Private Function StripNulls(startstr As String) As String
'Routine used by older VB4-32 / VB5 / VB6 code demo only
'Take a string separated by chr$(0)
'and split off 1 item, shortening the
'string so next item is ready for removal.
Dim pos As Long
pos = InStr(startstr$, Chr$(0))
If pos Then
StripNulls = Mid$(startstr, 1, pos - 1)
startstr = Mid$(startstr, pos + 1, Len(startstr))
End If
End Function
