Visual Basic > Windows and Controls

Get and set volume information for a drive

Get and set volume information for a drive

Below are two routines which get and set drive volume information.

Option Explicit

Private Declare Function SetVolumeLabel Lib "Kernel32" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long
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


'Purpose     :  Changes to label for a specified local drive
'Inputs      :  sDrive              The drive letter eg. "C:\"
'               sDriveLabel         The label for the drive
'Outputs     :  Returns True if succeeded in labeling the drive.


Function DriveChangeName(ByVal sDrive As String, sDriveLabel As String) As Boolean
    On Error Resume Next
    sDrive = Left$(sDrive, 1) & ":\"
    DriveChangeName = (SetVolumeLabel(sDrive, sDriveLabel) <> 0)
    On Error GoTo 0
End Function

'Purpose     :  Returns volume information on the specified drive
'Inputs      :  sDrive              The drive letter eg. "C:\"
'Outputs     :  Returns empty if failed else returns a one based, 1d string array, where:
'               DriveInformation(1) = Drive Name
'               DriveInformation(2) = File system name
'               DriveInformation(3) = Drive Serial number


Function DriveInformation(ByVal sDrive As String) As Variant
    Const clMaxLen As Long = 255
    Dim lSerial As Long
    Dim sDriveName As String * clMaxLen, sFileSystemName As String * clMaxLen
    Dim avResults(1 To 3) As String
    
    sDrive = Left$(sDrive, 1) & ":\"
    'Get the volume information
    If GetVolumeInformation(sDrive, sDriveName, clMaxLen, lSerial, 0, 0, sFileSystemName, clMaxLen) Then
        'Format output
        avResults(1) = "Drive name: " & Left$(sDriveName, InStr(1, sDriveName, vbNullChar) - 1)
        avResults(2) = "File system name: " & Left$(sFileSystemName, InStr(1, sFileSystemName, vbNullChar) - 1)
        avResults(3) = "Serial number: " & Trim$(Str$(lSerial))
        DriveInformation = avResults
    Else
        DriveInformation = Empty
    End If
End Function

'Demonstration routine
Sub Test()
    Dim avResults As Variant, vThisInfo As Variant
    
    'Get Drive information
    avResults = DriveInformation("f")
    If IsArray(avResults) Then
        For Each vThisInfo In avResults
            Debug.Print vThisInfo
        Next
    End If
    'Change Drive name
    Call DriveChangeName("F:\", "Work")
End Sub