'NTDLL
Private Declare Function NtQueryInformationProcess Lib "NTDLL" (ByVal hProcess As Long, ByVal ProcessInformationClass As Long, ProcessInformation As Any, ByVal ProcessInformationLength As Long, ReturnLength As Long) As Long
 
Private Type PROCESS_DEVICEMAP_INFORMATION
    DriveMap                As Long
    DriveType(1 To 32)      As Byte
End Type
 
Private Const ProcessDeviceMap = 23
 
Public Function NtGetPenDrives() As Collection
    Dim cTMP                As New Collection
    Dim tPDC                As PROCESS_DEVICEMAP_INFORMATION
    Dim i                   As Long
    Dim lMask               As Long
 
    If NtQueryInformationProcess(-1, ProcessDeviceMap, tPDC, Len(tPDC), ByVal 0&) = 0 Then
        For i = 1 To 25
            If tPDC.DriveMap And 2 ^ i Then
                If (tPDC.DriveType(i + 1) = 2) Then
                    cTMP.Add Chr$(65 + i) & ":\"
                End If
            End If
        Next i
    End If
 
    Set NtGetPenDrives = cTMP
End Function

Sub Main()
    Dim v                   As Variant
 
    For Each v In NtGetPenDrives
        Debug.Print v
    Next v
End Sub

• No incluye la unidad A:
• No filtra las unidades por BusType...

http://www.advancevb.com.ar/?p=335