I'm OK if some of the strings could be empty or zero (as long as not all of them are). I'm wondering if and how this runs under Win32 (I can probably test that myself) and on Apple hardware. I'd appreciate if Someone who could maybe test this and let me know. For all others, this is FYI (and enhancements and suggestions are welcome as always)
Code: Select all
Option Explicit
Sub t()
Dim S As String
S = "Proc rev.:" & vbTab & vbTab & Environ("PROCESSOR_REVISION") & vbCrLf
S = S & "MB Serial:" & vbTab & MBSerialNumber & vbCrLf
S = S & "HD Manuf Serial:" & vbTab & HD_Manu_Serial
MsgBox S, vbInformation, "Hardware ID"
End Sub
Public Function MBSerialNumber() As String
'Ref to Microsoft WMI Scripting Library required
Dim WMI As Object, oItems As Object, oItem As Object
'
Set WMI = GetObject("WinMgmts:")
Set oItems = WMI.InstancesOf("Win32_BaseBoard")
'
For Each oItem In oItems
MBSerialNumber = oItem.SerialNumber
Exit For
Next
End Function
Function HD_Manu_Serial() As String
Dim oWMI As Object, oItems As Object, oItem As Object, Ser As String
Set oWMI = GetObject("winmgmts:") '{impersonationLevel=impersonate}!\\.\root\cimv2")
Set oItems = oWMI.ExecQuery("Select * from Win32_DiskDrive")
'
For Each oItem In oItems
On Error Resume Next
'Debug.Print "Index: " & oItem.Index
'Debug.Print "InterfaceType: " & oItem.InterfaceType
'Debug.Print "DeviceID: " & oItem.DeviceID
'Debug.Print "Model: " & oItem.Model
'Debug.Print "Manufacturer SerialNo: " & oItem.SerialNumber
If oItem.InterfaceType <> "USB" And oItem.SerialNumber <> 0 Then Ser = oItem.SerialNumber
On Error GoTo 0
Next
Set oItem = Nothing
Set oItems = Nothing
Set oWMI = Nothing
'
If Right(Ser, 1) = "." Then Ser = Left(Ser, Len(Ser) - 1)
HD_Manu_Serial = Ser
End Function