Just paste this source code into a class module called cVolumeInfo and include it in your project.
'----------------------------------------------------------------------
'
' Module Name: cVolumeInfo
' Written By: C&D Programming Corp.
' Create Date: 7/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
'
' This API call allows us to gather volume information
'
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
'
' This API call allows us determine what type of
' we are looking at.
'
Private Declare Function GetDriveType Lib "KERNEL32" _
Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
'
' Return values from the GetDriveType API call
'
Private Const DRIVE_UNKNOWN = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
Dim msDrive As String
Dim msLabel As String
Public Property Get Drive() As String
Drive = msDrive
End Property
Public Property Let Drive(sDrive As String)
On Error Goto Handler
If Left(sDrive, 2) = "\\" Then
Err.Raise 5, "cVolumeInfo.Drive", "Network drives are not supported in this version."
Exit Property
Else
msDrive = Left(sDrive, 1) & ":\"
End If
GetVolumeLabel
Exit Property
Handler:
Err.Raise Err.Number, Err.Source, Err.Description
End Property
Public Property Get Label() As String
Label = msLabel
End Property
Private Sub GetVolumeLabel()
Dim lRet As Long
Dim sLabel As String
Dim lLabelSize As Long
Dim lSerialNumber As Long
Dim lMaxComponentLen As Long
Dim lFileSysFlags As Long
Dim sFileSysName As String
Dim lFileSysNameSize As Long
Dim lDriveType As Long
lDriveType = GetDriveType(Drive)
'
' don't include unknown drives and network drives
'
If lDriveType <> DRIVE_UNKNOWN And lDriveType <> DRIVE_REMOTE Then
sLabel = String$(64, 0)
lLabelSize = 63
lRet = GetVolumeInformation(Drive, sLabel, lLabelSize, lSerialNumber, _
lMaxComponentLen, lFileSysFlags, sFileSysName, lFileSysNameSize)
Select Case Err.LastDllError
Case 21
msLabel = "" ' device is not ready
Case 111
' buffer for label not large enough.
Case 0 ' success
msLabel = Left(sLabel, lLabelSize)
Case Else
msLabel = ""
Err.Raise Err.LastDllError, "cVolumeInfo.GetVolumeLabel", "API Error " & Err.LastDllError
End Select
Else
msLabel = ""
End If
End Sub