Computer identification using Excel VB

[Dvid Hall]

Hi

I would like to setup a macro within Excel that checks
which computer is using a particular Excel Doc.

I know of the Excel VBA command: Application.UserName and
the more complex VB codes to recall the NT network name
and computer name.
However these could be changed relatively easily for stand
alone computers.

Is there a command that gets the computer's "Hard Disc
Serial Number" or any other unique reference number that
identifies the particular computer ?

I use Excel 2003, and I am trying to find a way of
limiting the use of a particular Excel Doc to certain
users.

Many thanks for your input and comments

David Hall

 

[Bob Phillips]

David,

A couple of ways

Using FSO

Function DiskVolumeId() As String
Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
DiskVolumeId = Format(CDbl(FSO.Drives("C:").SerialNumber))
End Function


Using API

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

Function DriveiD(Drive As String)
Const cMaxPath As Long = 256
Dim nTemp
Dim sTemp As String
Dim nRet As Long
Dim nVolSerial As Long
Dim sVolName As String * cMaxPath
Dim nMaxCompLen As Long
Dim nFileSysFlags As Long
Dim sFileSysName As String * cMaxPath

If Right(Drive, 1) <> "\" Then Drive = Drive & "\"
nRet = GetVolumeInformation(Drive, sVolName, cMaxPath, _
nTemp, nMaxCompLen, nFileSysFlags, _
sFileSysName, cMaxPath)
sTemp = Format(Hex(nTemp), "00000000")
sTemp = Left(sTemp, 4) & "-" & Right(sTemp, 4)

DriveiD = sTemp
End Function

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Frank Kabel]

Hi
one way: Get the serial number of your harddisk. Find below two
solutions:

1. Using the Windows Scripting Host (a repost from Bob Phillips):
Function DiskVolumeId() As String
Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
DiskVolumeId = Format(CDbl(FSO.Drives("C:").SerialNumber))
End Function

2. Or using API calls (if for example WSH is not available):
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

Function get_drive_serial()
Const cMaxPath = 256, cDrive = "C:\"
Dim lngtemp
Dim strTemp As String, lngRet As Long
Dim lngVolSerial As Long, strVolName As String * cMaxPath
Dim lngMaxCompLen As Long, lngFileSysFlags As Long
Dim strFileSysName As String * cMaxPath

lngRet = GetVolumeInformation(cDrive, strVolName, cMaxPath, _
lngTemp, lngMaxCompLen, lngFileSysFlags, strFileSysName, _
cMaxPath)
strTemp = Format(Hex(lngTemp), "00000000")
strTemp = Left(strTemp, 4) & "-" & Right(strTemp, 4)

get_drive_serial = strTemp
End Sub

 

[Michel Pierron]

Hi David,
MsgBox
Hex(CreateObject("Scripting.FileSystemObject").Drives.Item("C").SerialNumber
)
MP

 

[Frank Kabel]

Hi Bob
lol
seems we have both the same library
AND are posting at the same time!

 

[Bob Phillips]

Yeah, I swear you are reading my mind at times.

Bob

 

[Frank Kabel]

rotflol

 

[David Hall]

Bob and Frank

Many thanks, a great help
David

-----Original Message-----
Yeah, I swear you are reading my mind at times.

Bob




.

 

[Frank Kabel]

Hi
thanks for your feedback