Option Compare Database
Option Explicit
Private Declare Function apiGetVolumeInformation 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 MAX_PATH = 260
Function fVolume1(strDriveLetter As String) As String
' Function to return the volume label for a drive
' Accepts:
' strDriveLetter - a valid drive letter for the PC, in the format "C:\"
' Returns:
' The volume label if it exists, or else "No label"
Dim strVolume As String
strVolume = Dir(strDriveLetter, vbVolume)
If strVolume = "" Then strVolume = "No label"
fVolume1 = strVolume
End Function
Function fVolume2(strDriveLetter As String) As String
' Function to return the volume label for a drive
' Accepts:
' strDriveLetter - a valid drive letter for the PC, in the format "C:\"
' Returns:
' The volume label if it exists, or else "No label"
Dim lngReturn As Long, lngDummy1 As Long, lngDummy2 As Long, lngDummy3 As Long
Dim strVolume As String, strDummy As String
strVolume = Space(MAX_PATH)
strDummy = Space(MAX_PATH)
lngReturn = apiGetVolumeInformation(strDriveLetter, strVolume, Len(strVolume), lngDummy1, lngDummy2, lngDummy3, strDummy, Len(strDummy))
strVolume = Left(strVolume, InStr(strVolume, vbNullChar) - 1)
If strVolume = "" Then strVolume = "No label"
fVolume2 = strVolume
End Function
Function fSerialNumber(strDriveLetter As String) As String
' Function to return the serial number for a hard drive
' Accepts:
' strDriveLetter - a valid drive letter for the PC, in the format "C:\"
' Returns:
' The serial number for the drive, formatted as "xxxx-xxxx"
Dim lngReturn As Long, lngDummy1 As Long, lngDummy2 As Long, lngSerial As Long
Dim strDummy1 As String, strDummy2 As String, strSerial As String
strDummy1 = Space(MAX_PATH)
strDummy2 = Space(MAX_PATH)
lngReturn = apiGetVolumeInformation(strDriveLetter, strDummy1, Len(strDummy1), lngSerial, lngDummy1, lngDummy2, strDummy2, Len(strDummy2))
strSerial = Trim(Hex(lngSerial))
strSerial = String(8 - Len(strSerial), "0") & strSerial
strSerial = Left(strSerial, 4) & "-" & Right(strSerial, 4)
fSerialNumber = strSerial
End Function