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
Comments