Computer Identification using VBA in Excel

[David Hall]

Hi

A bit of a challenging problem here as a previously
provided solution (that seemed excellent to me) doesn't
quite provide the right answer.

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

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

An earlier posting provided the following codes - which
unfortunately give the same answer on different computers
that have the same manufacturer and are the same model:

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


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

 

[kkknie]

I got this one from some BB recently. It gets usernames rather tha
serial #s.

Public Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function UserName() As String
Dim sName As String * 256
Dim cChars As Long

cChars = 256

If GetUserName(sName, cChars) Then
UserName = Left$(sName, cChars - 1)
End If
End Function

 

[David Hall]

Thanks for this, unfortunately this only identifies the
user not the computer.

David

 

[Michel Pierron]

Hi David,
With CreateObject("WScript.Network")
MsgBox "Domain = " & .UserDomain & vbLf _
& "Computer Name = " & .ComputerName & vbLf _
& "User Name = " & .UserName
End With

MP