CodeItBetter Programming Another VB Programming Blog

'System & API - How to list down all necessary Drive information
'You need to set reference to Microsoft Scripting Runtime

Public Function DriveInfo(Optional strDriveLetter As String = "C")
    Dim fldr As Folder
    Dim fso As New Scripting.FileSystemObject
    Dim drv As Scripting.Drive
    Dim strType As String
    'Make sure there is only one drive letter
    If Len(strDriveLetter) > 1 Then
        MsgBox "Unknown Drive Letter"
        Exit Function
    End If
    'Make sure the drive exists
    If Not fso.DriveExists(strDriveLetter & ":") Then
        MsgBox "Unknown Drive. Drive doesn't exist."
        Exit Function
    End If
    Set drv = fso.GetDrive(fso.GetDriveName(strDriveLetter & ":"))
    Debug.Print vbCrLf & "Drive Information for " & UCase$(strDriveLetter) & " Drive"
    Debug.Print "============================="
    Debug.Print "Available space   : " & FormatNumber(drv.AvailableSpace / 1024, 0) & " KB"
    Debug.Print "Drive letter      : " & drv.DriveLetter
    Select Case drv.DriveType
        Case 0: strType = "Unknown"
        Case 1: strType = "Removable"
        Case 2: strType = "Fixed"
        Case 3: strType = "Network"
        Case 4: strType = "CD-ROM"
        Case 5: strType = "RAM Disk"
    End Select
    Debug.Print "Drive type        : " & strType
    Debug.Print "Drive file system : " & drv.FileSystem
    Debug.Print "Drive free space  : " & FormatNumber(drv.FreeSpace / 1024, 0) & " KB"
    Debug.Print "Drive is ready    : " & drv.IsReady
    Debug.Print "Drive path        : " & drv.Path
    Debug.Print "Root folder       : " & drv.RootFolder
    Debug.Print "Serial number     : " & drv.SerialNumber
    Debug.Print "Share name        : " & drv.ShareName
    Debug.Print "Total size        : " & FormatNumber(drv.TotalSize / 1024, 0) & " KB"
    Debug.Print "Volume  name      : " & drv.VolumeName
End Function