product id

product id

• amiratish

  Hi Andrej,
  
  

  Here is the sample code about how to obtain product IDS via VBA (from our support engineer).< xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

  =========================================================================

   

  Option Explicit

  Public Const REG_NONE As Long = 0

  Public Const REG_SZ As Long = 1

  Public Const REG_EXPAND_SZ As Long = 2

  Public Const REG_BINARY As Long = 3

  Public Const REG_DWORD As Long = 4

  Public Const REG_LINK As Long = 6

  Public Const REG_MULTI_SZ As Long = 7

  Public Const REG_RESOURCE_LIST As Long = 8

  ' Registry section definitions

  Public Const HKEY_CLASSES_ROOT = &H80000000

  Public Const HKEY_CURRENT_USER = &H80000001

  Public Const HKEY_LOCAL_MACHINE = &H80000002

  Public Const HKEY_USERS = &H80000003

  Public Const HKEY_PERFORMANCE_DATA = &H80000004

  Public Const HKEY_CURRENT_CONFIG = &H80000005

  Public Const HKEY_DYN_DATA = &H80000006

  ' Codes returned by Reg API calls

  Private Const ERROR_NONE = 0

  Private Const ERROR_BADDB = 1

  Private Const ERROR_BADKEY = 2

  Private Const ERROR_CANTOPEN = 3

  Private Const ERROR_CANTREAD = 4

  Private Const ERROR_CANTWRITE = 5

  Private Const ERROR_OUTOFMEMORY = 6

  Private Const ERROR_INVALID_PARAMETER = 7

  Private Const ERROR_ACCESS_DENIED = 8

  Private Const ERROR_INVALID_PARAMETERS = 87

  Private Const ERROR_NO_MORE_ITEMS = 259

  Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

   

  Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

   

  Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

   

  ' Example code begin

   

  Sub test()

  Dim winpid As String

  Dim officepid As String

  winpid = ReadRegistry(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\", "ProductId")

  officepid = ReadRegistry(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Office\11.0\Registration\{90110409-6000-11D3-8CFE< xml:namespace prefix = st1 ns = "urn:schemas-microsoft-com:office:smarttags" />-0150048383C9}\", "ProductId")

  MsgBox "windows product id is " & winpid

  MsgBox "office product id is " & officepid

   

  End Sub

   

  '

  Public Function ReadRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String) As String

  Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long, sValue As String, td As Double

  Dim TStr1 As String, TStr2 As String

  Dim i As Integer

  On Error Resume Next

  lResult = RegOpenKey(Group, Section, lKeyValue)

  sValue = Space$(2048)

  lValueLength = Len(sValue)

  lResult = RegQueryValueEx(lKeyValue, Key, 0&, lDataTypeValue, sValue, lValueLength)

  If (lResult = 0) And (Err.Number = 0) Then

     If lDataTypeValue = REG_DWORD Then

        td = Asc(Mid$(sValue, 1, 1)) + &H100& * Asc(Mid$(sValue, 2, 1)) + &H10000 * Asc(Mid$(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(sValue, 4, 1)))

        sValue = Format$(td, "000")

     End If

     If lDataTypeValue = REG_BINARY Then

         ' Return a binary field as a hex string (2 chars per byte)

         TStr2 = ""

         For i = 1 To lValueLength

            TStr1 = Hex(Asc(Mid(sValue, i, 1)))

            If Len(TStr1) = 1 Then TStr1 = "0" & TStr1

            TStr2 = TStr2 + TStr1

         Next

         sValue = TStr2

     Else

        sValue = Left$(sValue, lValueLength - 1)

     End If

  Else

     sValue = "Not Found"

  End If

  lResult = RegCloseKey(lKeyValue)

  ReadRegistry = sValue

  End Function

   
  
  -brenda (ISV Buddy Team)

  
  
  
• product id