'Para saber la informacion de una unidad de disco

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

Private Const FS_CASE_IS_PRESERVED = 2
Private Const FS_CASE_SENSITIVE = 1
Private Const FS_UNICODE_STORED_ON_DISK = 4
Private Const FS_PERSISTENT_ACLS = 8
Private Const FS_FILE_COMPRESSION = 16
Private Const FS_VOL_IS_COMPRESSED = 32768

'en cualquier parte del programa...
Dim strRootPathName As String
Dim strVolumeNameBuffer As String * 256
Dim lngVolumeNameSize As Long
Dim lngVolumeSerialNumber As Long
Dim lngMaximumComponentLength As Long
Dim lngFileSystemFlags As Long
Dim strFileSystemNameBuffer As String * 256
Dim lngFileSystemNameSize As Long
Dim strMessage As String

    strRootPathName = "C:\" 'drive letter
    
    If GetVolumeInformation(strRootPathName, strVolumeNameBuffer, Len(strVolumeNameBuffer), lngVolumeSerialNumber, lngMaximumComponentLength, lngFileSystemFlags, strFileSystemNameBuffer, Len(strFileSystemNameBuffer)) = 0 Then
        strMessage = "An error occurred!"
    Else
        strMessage = strRootPathName
        strVolumeNameBuffer = Left$(strVolumeNameBuffer, InStr(strVolumeNameBuffer, Chr$(0)) - 1)
        strMessage = strMessage & vbCrLf & "Volume Name: " & strVolumeNameBuffer
        strMessage = strMessage & vbCrLf & "Serial number: " & Format$(lngVolumeSerialNumber)
        strMessage = strMessage & vbCrLf & "Max component length: " & Format$(lngMaximumComponentLength)
        strMessage = strMessage & vbCrLf & "System Flags: "
        If lngFileSystemFlags And FS_CASE_IS_PRESERVED Then strMessage = strMessage & vbCrLf & "    FS_CASE_IS_PRESERVED"
        If lngFileSystemFlags And FS_CASE_SENSITIVE Then strMessage = strMessage & vbCrLf & "    FS_CASE_SENSITIVE"
        If lngFileSystemFlags And FS_UNICODE_STORED_ON_DISK Then strMessage = strMessage & vbCrLf & "    FS_UNICODE_STORED_ON_DISK"
        If lngFileSystemFlags And FS_PERSISTENT_ACLS Then strMessage = strMessage & vbCrLf & "    FS_PERSISTENT_ACLS"
        If lngFileSystemFlags And FS_FILE_COMPRESSION Then strMessage = strMessage & vbCrLf & "    FS_FILE_COMPRESSION"
        If lngFileSystemFlags And FS_VOL_IS_COMPRESSED Then strMessage = strMessage & vbCrLf & "    FS_VOL_IS_COMPRESSED"
        strFileSystemNameBuffer = Left$(strFileSystemNameBuffer, InStr(strFileSystemNameBuffer, Chr$(0)) - 1)
        strMessage = strMessage & vbCrLf & "File System: " & strFileSystemNameBuffer
    End If

    MsgBox (strMessage)

    Source: geocities.com/es/ensolva/Descargas/Documentos

               ( geocities.com/es/ensolva/Descargas)                   ( geocities.com/es/ensolva)                   ( geocities.com/es)