Private Declare Function GetDriveType Lib "kernel32" _
   Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
   Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
   ByVal lpBuffer As String) As Long
'GetDriveType()的传回值意义如下：
'0   The drive type cannot be determined.
'1   The root directory does not exist.
'2   The drive can be removed from the drive.
'3   The disk cannot be removed from the drive.
'4   The drive is a remote (network) drive.
'5   The drive is a CD-ROM drive.
'6   The drive is a RAM disk.

Private Sub Command1_Click()
Dim drv() As String, i As Long
Dim DrvType As Long
Call GetAvailDriver(drv())
For i = LBound(drv) To UBound(drv)
    DrvType = GetDriveType(drv(i))
    Select Case DrvType
      Case 2
         Debug.Print drv(i), "软碟"
      Case 3
         Debug.Print drv(i), "硬碟"
      Case 4
         Debug.Print drv(i), "网路磁碟"
      Case 5
         Debug.Print drv(i), "光碟"
      Case 6
         Debug.Print drv(i), "RamDisk"
      Case Else
         Debug.Print drv(i), "不明"
    End Select
Next i
End Sub

'取得所有可用的DiskDriver List
Public Sub GetAvailDriver(DriverName() As String)
Dim totlen As Long
Dim buff As String, totDrvCnt As Long
Dim i As Long, tmpstr As String, j As Long
buff = String(255, 0)
totlen = GetLogicalDriveStrings(256, buff)
'取得的值如: "a:\"+Chr(0)+"c:\"+Chr(0) + "d:\"+Chr(0) + Chr(0)
'而这个例子中传回长度(totlen)是12
buff = Left(buff, totlen)
totDrvCnt = 0
For i = 1 To totlen
   tmpstr = Mid(buff, i, 1)
   If tmpstr = Chr(0) Then
      totDrvCnt = totDrvCnt + 1
   End If
Next i
ReDim DriverName(totDrvCnt - 1)
j = 0
For i = 1 To totDrvCnt
    j = InStr(1, buff, Chr(0))
    DriverName(i - 1) = Left(buff, j - 1)
    buff = Mid(buff, j + 1)
Next i
End Sub

[1]