TypeDisk

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

Const DRIVE_UNKNOWN = 0 ' type can't be determined
Const DRIVE_NO_ROOT_DIR = 1 ' wrong argument
Const DRIVE_REMOVABLE = 2
Const DRIVE_FIXED = 3
Const DRIVE_REMOTE = 4
Const DRIVE_CDROM = 5
Const DRIVE_RAMDISK = 6

' Determine the type of a drive. If you pass a null string it returns

' the type of the current drive

'

' Returns one of the DRIVE_* constants, and stores in the optional

' DriveDescription argument a textual description of the result


Function DriveType(ByVal DriveName As String, Optional DriveDescription As _
String) As Long

If Len(DriveName) = 0 Then
' use NULL if a null string has been passed (default drive)

DriveName = vbNullString
Else
' otherwise always provide a colon and backslash

DriveName = Left$(DriveName, 1) & ":\"
End If

DriveType = GetDriveType(DriveName)
Select Case DriveType
Case DRIVE_UNKNOWN
DriveDescription = "(unknown)"
Case DRIVE_REMOVABLE
DriveDescription = "Removable Drive"
Case DRIVE_FIXED
DriveDescription = "Fixed Drive"
Case DRIVE_REMOTE
DriveDescription = "Remote Drive"
Case DRIVE_CDROM
DriveDescription = "CD-ROM"
Case DRIVE_RAMDISK
DriveDescription = "RAM Disk"
Case Else
' this includes the DRIVE_NO_ROOT_DIR case

DriveDescription = ""
End Select

End Function