VB and VBA Users Source Code: Get and set volume information for a drive
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Get and set volume information for a drive
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, March 05, 2001
Hits:
734
Category:
Windows API
Article:
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. 'Author : Andrew Baker 'Date : 14/01/2001 12:20 'Notes : 'Revisions : 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 'Author : Andrew Baker 'Date : 14/01/2001 12:20 'Notes : 'Revisions : 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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
