Finding the drive


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


In short
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Sub Command1_Click()
Dim x
x = GetDriveType(ByVal "c:\")
Form1.Print x
End Sub

Select Case lAns
case 0
The drive type cannot be determined.
case 1
The root directory does not exist.
Case 2
sAns = "Removable Drive"
Case 3
sAns = "Fixed Drive"
Case 4
sAns = "Remote Drive"
Case 5
sAns = "CD-ROM"
Case 6
sAns = "RAM Disk"
Case Else
sAns = "Drive Doesn't Exist"
End Select


Private Function DriveType(Drive As String) As String
Dim sAns As String, lAns As Long
'fix bad parameter values
If Len(Drive) = 1 Then Drive = Drive & ":\"
If Len(Drive) = 2 And Right$(Drive, 1) = ":" _
Then Drive = Drive & "\"

lAns = GetDriveType(Drive)
Select Case lAns
Case 2
sAns = "Removable Drive"
Case 3
sAns = "Fixed Drive"
Case 4
sAns = "Remote Drive"
Case 5
sAns = "CD-ROM"
Case 6
sAns = "RAM Disk"
Case Else
sAns = "Drive Doesn't Exist"
End Select

DriveType = sAns
End Function

FormCenter Me
Dim ictr As Integer
Dim iDriveCount As Integer
Dim sAllDrives As String
Dim sDrive As String
ReDim sDrives(0) As String

For ictr = 66 To 90
sDrive = Chr(ictr) & ":\"
If DriveType(sDrive) = "Fixed Drive" Then
If sDrives(0) = "" Then
sDrives(0) = sDrive
Else
ReDim Preserve sDrives(UBound(sDrives) + 1) As String
sDrives(UBound(sDrives)) = sDrive
End If

cboDrives.AddItem sDrive
If sAllDrives <> "" Then sAllDrives = sAllDrives & ", "
sAllDrives = sAllDrives & sDrive
iDriveCount = iDriveCount + 1
End If
Next

If iDriveCount > 1 Then
sAllDrives = "All Hard Drives (" & sAllDrives & ")"
cboDrives.AddItem sAllDrives
End If

cboDrives.ListIndex = 0
EnableSearch

Hosted by www.Geocities.ws

1