On Jun 14, 5:14*pm, "Jon Lewis" <jon.le...@cutthespambtinternet.com>
wrote:
> The following is code provided in Visual Basic 6 which works in VBA:
>
> In a command button On Click event:
> Call StartSysInfo
>
> Copy the following code into a Standard Module (correct any word wrap):
> *********************Start**********************
> Option Compare Database
> Option Explicit
> ' Reg Key Security Options...
> Const READ_CONTROL = &H20000
> Const KEY_QUERY_VALUE = &H1
> Const KEY_SET_VALUE = &H2
> Const KEY_CREATE_SUB_KEY = &H4
> Const KEY_ENUMERATE_SUB_KEYS = &H8
> Const KEY_NOTIFY = &H10
> Const KEY_CREATE_LINK = &H20
> Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
> * * * * * * * * * * * *KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
> * * * * * * * * * * * *KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
>
> ' Reg Key ROOT Types...
> Const HKEY_LOCAL_MACHINE = &H80000002
> Const ERROR_SUCCESS = 0
> Const REG_SZ = 1 * * * * * * * * * * * * ' Unicode nul terminated string
> Const REG_DWORD = 4 * * * * * * * * * * *' 32-bitnumber
>
> Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
> Const gREGVALSYSINFOLOC = "MSINFO"
> Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
> Const gREGVALSYSINFO = "PATH"
>
> Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA"
> (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long,
> ByVal samDesired As Long, ByRef phkResult As Long) As Long
> Private Declare Function RegQueryValueEx Lib "advapi32" Alias
> "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
> lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef
> lpcbData As Long) As Long
> Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As
> Long
>
> Public Sub StartSysInfo()
> * * On Error GoTo SysInfoErr
>
> * * Dim rc As Long
> * * Dim SysInfoPath As String
>
> * * ' Try To Get System Info Program Path\Name From Registry...
> * * If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO,
> SysInfoPath) Then
> * * ' Try To Get System Info Program Path Only From Registry...
> * * ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC,
> gREGVALSYSINFOLOC, SysInfoPath) Then
> * * * * ' Validate Existance Of Known 32 Bit File Version
> * * * * If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
> * * * * * * SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
>
> * * * * ' Error - File Can Not Be Found...
> * * * * Else
> * * * * * * GoTo SysInfoErr
> * * * * End If
> * * ' Error - Registry Entry Can Not Be Found...
> * * Else
> * * * * GoTo SysInfoErr
> * * End If
>
> * * Call Shell(SysInfoPath, vbNormalFocus)
>
> * * Exit Sub
> SysInfoErr:
> * * MsgBox "System Information Is Unavailable At This Time", vbOKOnly
> End Sub
>
> Private Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef
> As String, ByRef KeyVal As String) As Boolean
> * * Dim i As Long * * * * * * * * * * * * ** * * * * * * * ' Loop Counter
> * * Dim rc As Long * * * * * * * * * * * * * * * * * * * * *' Return Code
> * * Dim hKey As Long * * * * * * * * * * * * * * * * * * * *' Handle To An
> Open Registry Key
> * * Dim hDepth As Long * * * * * * * * * * * * * * * * * * *'
> * * Dim KeyValType As Long * * * * * * * * * * * * * * * * *' Data Type Of A
> Registry Key
> * * Dim tmpVal As String * * * * * * * * * * * * * * * * * *' Tempory
> Storage For A Registry Key Value
> * * Dim KeyValSize As Long * * * * * * * * * * * * * * * * *' Size Of
> Registry Key Variable
> * * '------------------------------------------------------------
> * * ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
> * * '------------------------------------------------------------
> * * rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open
> Registry Key
>
> * * If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError * * * * *' Handle
> Error...
>
> * * tmpVal = String$(1024, 0) * * * * * * * * * * * * * * ' Allocate
> Variable Space
> * * KeyValSize = 1024 * * * * * * * * * * * * * * * * * * * ' Mark Variable
> Size
>
> * * '------------------------------------------------------------
> * * ' Retrieve Registry Key Value...
> * * '------------------------------------------------------------
> * * rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
> * * * * * * * * * * * * *KeyValType, tmpVal, KeyValSize) * *' Get/Create Key
> Value
>
> * * If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError * * * * *' Handle Errors
>
> * * If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then * * * * * ' Win95 Adds
> Null Terminated String...
> * * * * tmpVal = Left(tmpVal, KeyValSize - 1) * * * * * * * ' Null Found,
> Extract From String
> * * Else * * * * * * * * * * * * * * * * * * * * * * * * * *' WinNT Does NOT
> Null Terminate String...
> * * * * tmpVal = Left(tmpVal, KeyValSize) * * * * * * * * * ' Null Not
> Found, Extract String Only
> * * End If
> * * '------------------------------------------------------------
> * * ' Determine Key Value Type For Conversion...
> * * '------------------------------------------------------------
> * * Select Case KeyValType * * * * * * * * * * * * * * * * *' Search Data
> Types...
> * * Case REG_SZ * * * * * * * * * * * * * * * * * * * * * * ' String
> Registry Key Data Type
> * * * * KeyVal = tmpVal * * * * * * * * * ** * * * * * * * ' Copy String
> Value
> * * Case REG_DWORD * * * * * * * * * * * * * * * * * * * * *' Double Word
> Registry Key Data Type
> * * * * For i = Len(tmpVal) To 1 Step -1 * * * * * * * * * *' Convert Each
> Bit
> * * * * * * KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) * ' Build Value
> Char. By Char.
> * * * * Next
> * * * * KeyVal = Format$("&h" + KeyVal) * * * * * ** * * * ' Convert Double
> Word To String
> * * End Select
>
> * * GetKeyValue = True * * * * * * * * * * * * * * * * * * *' Return Success
> * * rc = RegCloseKey(hKey) * * * * * * * * * * * * * * * * *' Close Registry
> Key
> * * Exit Function * * * * * * * * * * * * ** * * * * * * * ' Exit
>
> GetKeyError: * * *' Cleanup After An Error Has Occured...
> * * KeyVal = "" * * * * * * * * * * * * ** * * * * * * * * ' Set Return Val
> To Empty String
> * * GetKeyValue = False * * * * * * * * * * ** * * * * * * ' Return Failure
> * * rc = RegCloseKey(hKey) * * * * * * * * * * * * * * * * *' Close Registry
> Key
> End Function
>
> ********************End***********************
>
> HTH
>
> Jon"LightLY" <lightai...@gmail.com> wrote in message
>
> news:163fc460-9230-4922-ab22-(E-Mail Removed)...
>
> > Dear Access experts,
>
> > I would like to retrieve PC system configuration information like MAC
> > address, Operating System Type using Access VBA. May I know if this
> > can be done? If yes, could someone point me to some VBA command as a
> > start?
>
> > Thank you very much.
Thank you very much for your helpful reply. I will try that out. What
worries me is that the code provided may not work equally on all
Microsoft OS (windows 7, XP, 2000 etc)
Similar Threads
