SN Number

Sub Get_Environmental_Variable()
Dim sHostName As String

Dim sUserName As String
' Get Host Name / Get Computer Name

sHostName = Environ$("computername")
' Get Current User Name

sUserName = Environ$("username")
End Sub
CreateObject("Scripting.FileSystemObject").GetDrive("a:\").SerialNumber
Function HdNum() As String
Dim fsObj As Object
Dim drv As Object
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set drv = fsObj.Drives("C")
HdNum = Hex(drv.serialnumber)
End Function
Sub HD()
MsgBox HdNum
End Sub
Function HDSerialNumber() As String

Dim fsObj As Object
Dim drv As Object
HDSerialNumber = Left(Hex(drv.SerialNumber), 4) _
& "-" & Right(Hex(drv.SerialNumber), 4)
Debug.Print HDSerialNumber
End Function
Function GetPhysicalSerial() As Variant
Dim obj As Object

Dim WMI As Object
Dim SNList() As String, i As Long, Count As Long
Set WMI = GetObject("WinMgmts:")
For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")

If obj.SerialNumber <> "" Then
Count = Count + 1
Next
ReDim SNList(1 To Count, 1 To 1)
i = 1
SNList(i, 1) = obj.SerialNumber
i = i + 1
If i > Count Then
Exit For
Next
GetPhysicalSerial = SNList
End Function
Public function volumeserialnumber() as long

Dim vrtFileSystem As Variant
Dim vrtDrive As Variant
Set vrtFileSystem = CreateObject("Scripting.FileSystemObject")

Set vrtDrive =
vrtFileSystem.GetDrive(vrtFileSystem.GetDriveName(vrtFileSystem.GetAbsolutePathName
("c:\")))
volumeserialnumber= vrtDrive.serialNumber
debug.print volumeserialnumber
end function
Function GetPhysicalSerial() As Variant
Dim obj As Object

Dim WMI As Object
Dim SNList() As String, i As Long, Count As Long

If obj.SerialNumber <> "" Then Count = Count + 1
Next
ReDim SNList(1 To Count, 1 To 1)
i = 1
SNList(i, 1) = obj.SerialNumber
i = i + 1
If i > Count Then Exit For
Next
GetPhysicalSerial = SNList
End Function
Function HDSerialNumber() As String

Dim fsObj As Object
Dim drv As Object
HDSerialNumber = Left(Hex(drv.SerialNumber), 4) _
& "-" & Right(Hex(drv.SerialNumber), 4)
End Function
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 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
Sub ShowDriveInfo(drvpath)
Dim fs, d, t
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))
s = "Drive " & d.DriveLetter & ": - " & t
s = d.SerialNumber
MsgBox s
End Sub
Public Function myGetHDsn()

Dim objFSO, objDrive, colDrives
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
For Each objDrive In colDrives
MsgBox ("Drive letter: " & objDrive.DriveLetter & vbCrLf & _
"Drive type: " & objDrive.DriveType & vbCrLf & _
"File system: " & objDrive.FileSystem & vbCrLf & _
"Free space: " & objDrive.FreeSpace & vbCrLf & _
"Is ready: " & objDrive.IsReady & vbCrLf & _
"Path: " & objDrive.Path & vbCrLf & _
"Root folder: " & objDrive.RootFolder & vbCrLf & _
"Serial number: " & objDrive.SerialNumber & vbCrLf & _
"Share name: " & objDrive.ShareName & vbCrLf & _
"Total size: " & objDrive.TotalSize & vbCrLf & _
"Volume name: " & objDrive.VolumeName)
Next
End Function
Public Function TestDRV()

Dim objFSO, colDrives, objDrive
If objDrive.DriveType = 2 Then
MsgBox "Drive letter: " & objDrive.DriveLetter & vbCrLf & _
"Serial number: " & objDrive.SerialNumber
End If
Next
End FunctionPublic Function TestDRV()
Dim objFSO, colDrives, objDrive
If objDrive.DriveType = 2 Then
MsgBox "Drive letter: " & objDrive.DriveLetter & vbCrLf & _
"Serial number: " & objDrive.SerialNumber
End If
Next
End Function
Sub GetPhysicalSerial()
Dim obj As Object
Dim WMI As Object
Dim i As Integer
On Error GoTo GetPhysicalSerial_Error
i = i + 1
Debug.Print "HDD(" & i & ") SN: " & obj.serialnumber
Next
On Error GoTo 0
Exit Sub
GetPhysicalSerial_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
GetPhysicalSerial of Module GetDriveSerialNumber"
End Sub
Public Sub GetDiskInfo()

Dim HDD As Object
Dim WMI As Object
For Each HDD In WMI.InstancesOf("Win32_PhysicalMedia")
Debug.Print "Manufacturer: " & HDD.Manufacturer
Debug.Print "Serial Number: " & HDD.SerialNumber
Next
Set WMI = Nothing
End Sub

SN Number

Uploaded by

Copyright:

Available Formats

SN Number

Uploaded by

Document Information

Original Description:

Original Title

Copyright

Available Formats

Share this document

Share or Embed Document

Sharing Options

Did you find this document useful?

Is this content inappropriate?

Copyright:

Available Formats

SN Number

Uploaded by

Copyright:

Available Formats

Sub Get_Environmental_Variable()

Dim sHostName As String

' Get Host Name / Get Computer Name

' Get Current User Name

Function HdNum() As String

Dim fsObj As Object

Dim drv As Object

Set fsObj = CreateObject("Scripting.FileSystemObject")

Set drv = fsObj.Drives("C")

Function HDSerialNumber() As String

Function GetPhysicalSerial() As Variant

Dim obj As Object

Set WMI = GetObject("WinMgmts:")

For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")

ReDim SNList(1 To Count, 1 To 1)

Public function volumeserialnumber() as long

Set vrtFileSystem = CreateObject("Scripting.FileSystemObject")

Function GetPhysicalSerial() As Variant

Dim obj As Object

Set WMI = GetObject("WinMgmts:")

For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")

ReDim SNList(1 To Count, 1 To 1)

Function HDSerialNumber() As String

Option Compare Database

Private Declare Function apiGetVolumeInformation Lib "kernel32" Alias

Private Const MAX_PATH = 260

Function fSerialNumber(strDriveLetter As String) As String

Public Function myGetHDsn()

Public Function TestDRV()

Public Sub GetDiskInfo()

You might also like