Listing all drives

The following code will list all the drives in a combo box named cboDrives on a form named frmExample. You can download an example that uses all the given code by clicking here.

Public Const DRIVE_PARTITION = 1
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_FIXED = 3
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_CDROM = 5
Public Const DRIVE_RAMDISK = 6

Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" _
    (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, _
    ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _
    lpMaximumComponentLength As Long, lpFileSystemFlags As Long, _
    ByVal lpFileSystemNameBuffer As String, _
    ByVal nFileSystemNameSize As Long) As Long

Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
    (ByVal nDrive As String) As Long

Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _
    (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Public Function ListDrives()
  
    Dim sTemp As String, sTemp2 As String
    Dim iNullSpot As Integer
    Dim lDrive As Long
    Dim sSubDir As String
    Dim sSelectDrive As String

    ' get all of the drives on the computer
    sTemp = String$(2048, 0)
    Call GetLogicalDriveStrings(2047, sTemp)
    ' go through and add each drive to the list
    Do
        iNullSpot = InStr(sTemp, Chr$(0))
        If iNullSpot > 1 Then
            'get a drive letter and see which type of drive it is
            sTemp2 = UCase$(Left$(sTemp, iNullSpot - 2))
            lDrive = GetDriveType(sTemp2)
            sSubDir = ""
            Select Case lDrive
                'if it is fixed, cdrom, or net then see if it has sub dirs
                'so we can put the plus sign on it. Also, get the volume lable
                'and then add it to the list
                Case DRIVE_FIXED, DRIVE_PARTITION
                    sTemp2 = GetDriveName((sTemp2 & "")) & " (" & sTemp2 & ")"
                    If sSelectDrive = "" Then sSelectDrive = _
                        UCase$(Left$(sTemp, iNullSpot - 2))
                Case DRIVE_CDROM
                    sTemp2 = GetDriveName((sTemp2 & "")) & " (" & sTemp2 & ")"
                Case DRIVE_REMOTE
                    sTemp2 = GetDriveName((sTemp2 & "")) & " (" & sTemp2 & ")"
                Case DRIVE_REMOVABLE
                    'I don't check for sub dirs here because floppy drives are slow
                    'but it could be done
                    'For drive A: and B: sub dirs will be refreshed everytime a user
                    'clicks the drive icon. See tvwDirTree_NodeClick
                    'The other thing with type DRIVE_REMOVABLE is that at this time
                    'I can't figure out how to tell whether the drives are 3.5, 5.25, MO drives
                    'Zip drives, ect. They are all listed as "Floppy
                    'sSubDir = HasSubDirs(sTemp2)
                    sTemp2 = "Removable (" & sTemp2 & ")"
                Case Else
                    sTemp2 = "(" & sTemp2 & ")"
            End Select
            ' Add the node to the drive. The Key for each node holds it's path
            frmExample.cboDrive.AddItem sTemp2
           
            'Get the next drive letter
            sTemp = Mid$(sTemp, iNullSpot + 1)
        End If
    Loop Until iNullSpot <= 1
    ListDrives = sSelectDrive
End Function

Public Function GetDriveName(ByVal sDrive As String) As String
    Dim sVolBuf As String, sSysName As String
    Dim lSerialNum As Long, lSysFlags As Long, lComponentLength As Long
    Dim lRet As Long
   
    sVolBuf = String$(256, 0)
    sSysName = String$(256, 0)
    lRet = GetVolumeInformation(sDrive, sVolBuf, MAX_PATH, lSerialNum, _
        lComponentLength, lSysFlags, sSysName, MAX_PATH)
   
    If lRet > 0 Then
        sVolBuf = StripTerminator(sVolBuf)
        GetDriveName = StrConv(sVolBuf, vbProperCase)
    End If
End Function