Loading
Ozgrid Excel Help & Best Practices Forums

Excel Video Tutorials / Excel Dashboards Reports



Results 1 to 3 of 3

Thread: Product ID key via VBA

  1. #1
    Join Date
    18th February 2003
    Posts
    24

    Product ID key via VBA

    I'm trying to obtain the Excel Product Id key via VBA to use in a simple workbook licensing system. I want the Excel Product Id shown by the Excel Help. The workbook usage will be limited to licensed machines.

    I've looked at the earlier thread "Excel Product Key via VBA" and picked up the code to read the registry.

    The problem is the organization of the registry. Where do I look in the registry to find the Excel Product Id Key for all Excel installations?

    I have MS Office 2003 installed. To obtain the Excel key, I use:

    "Software\Microsoft\Office\11.0\Registration" & Application.ProductCode

    and the "ProductId".

    I doubt this will work if the user has a different version of MS Office installed or only Excel. I need the general method to find the Excel key.

    Does anybody know how to find the Excel Product Id key in the registry for all (most?) Excel installations?

    Also, Please submit any suggestions you have for better machine specific key(s).

    thanks.

    Excel Video Tutorials / Excel Dashboards Reports


  2. #2
    Join Date
    25th January 2003
    Location
    UK
    Posts
    2,745
    Hi,

    OK, first point - if you are going to post the same query to more than one forum please provide a link to the other posts. The reasons for this are outline in the "Please read this link" section when you post a new query : http://www.ozgrid.com/forum/CrossPosts.htm

    The other post is here:

    http://groups.google.com/groups?hl=e...el.programming

    For those interested the API code for obtaining the Product ID is as follows:
    VB:
    Const MAX_STRING As Long = 128 
    Public Const REG_BINARY = 3& 
    Public Const REG_DWORD = 4& 
     
    Declare Function RegOpenKeyA Lib "ADVAPI32.DLL" _ 
    (ByVal hkey As Long, _ 
    ByVal sKey As String, _ 
    ByRef plKeyReturn As Long) As Long 
     
    Declare Function RegQueryValueExA Lib "ADVAPI32.DLL" _ 
    (ByVal hkey As Long, _ 
    ByVal sValueName As String, _ 
    ByVal dwReserved As Long, _ 
    ByRef lValueType As Long, _ 
    ByVal sValue As String, _ 
    ByRef lResultLen As Long) As Long 
     
    Declare Function RegCloseKey Lib "ADVAPI32.DLL" _ 
    (ByVal hkey As Long) As Long 
     
    Public Const HKEY_CURRENT_USER = &H80000001 
    Public Const HKEY_LOCAL_MACHINE = &H80000002 
    ' 
     
    Sub ShowExcelProductID() 
        MsgBox GetRegistryValue(HKEY_LOCAL_MACHINE, _ 
        "Software\Microsoft\Microsoft Excel 97\97.2.0.0717(1033)\Registration", "ProductID") 
    End Sub 
     
    Function GetRegistryValue(KEY As Long, SubKey As String, _ 
        ValueName As String) As String 
        'Pass: 
        '   (1) the KEY (e.g., HKEY_CLASSES_ROOT), 
        '   (2) the SUBKEY (e.g., "Excel.Sheet.5"), 
        '   (3) the value's name (e.g., "" [for default] Or "whatever") 
         
         
        Dim Buffer As String * MAX_STRING, ReturnCode As Long 
        Dim KeyHdlAddr As Long, ValueType As Long, ValueLen As Long 
        Dim TempBuffer As String, Counter As Integer 
        ValueLen = MAX_STRING 
        ReturnCode = RegOpenKeyA(KEY, SubKey, KeyHdlAddr) 
        If ReturnCode = 0 Then 
            ReturnCode = RegQueryValueExA(KeyHdlAddr, ValueName, _ 
            0&, ValueType, Buffer, ValueLen) 
            RegCloseKey KeyHdlAddr 
            'If successful ValueType contains data type 
            ' of value And ValueLen its length 
            If ReturnCode = 0 Then 
                Select Case ValueType 
                Case REG_BINARY 
                    For Counter = 1 To ValueLen 
                        TempBuffer = TempBuffer & _ 
                        Stretch(Hex(Asc(Mid(Buffer, Counter, 1)))) & " " 
                    Next 
                    GetRegistryValue = TempBuffer 
                Case REG_DWORD 
                    TempBuffer = "0x" 
                    For Counter = 4 To 1 Step -1 
                        TempBuffer = TempBuffer & _ 
                        Stretch(Hex(Asc(Mid(Buffer, Counter, 1)))) 
                    Next 
                    GetRegistryValue = TempBuffer 
                Case Else 
                    GetRegistryValue = Buffer 
                End Select 
                Exit Function 
            End If 
        End If 
        GetRegistryValue = "Error" 
    End Function 
     
    Function Stretch(ByteStr As String) As String 
        If Len(ByteStr) = 1 Then ByteStr = "0" & ByteStr 
        Stretch = ByteStr 
    End Function 
    
    
    The problem for the OP is in getting the appropriate address to pass to the function.

    Unfortunately I'm not able to provide any help on this front. However, another test you could perform is on the serial number of the PC's hard drive (using the File System Object). Like this:
    VB:
    Sub SerialNumber() 
        Dim oFSO As Object 
        Dim drive As Object 
         
        Set oFSO = CreateObject("Scripting.FileSystemObject") 
        Set drive = oFSO.GetDrive("C:\") 
        MsgBox drive.SerialNumber 
         
        Set oFSO = Nothing 
        Set drive = Nothing 
        'release memory 
         
    End Sub 
    
    
    Keep in mind that Excel is not a secure environment and whatever steps you take, somebody will always find a way in if they are determined enough. Even simple things like opening the workbook without macros enabled will halt most steps that you might take. The best you can really do is make it sufficiently awkward that the majority of your users will comply with your wishes - you won't get 100% security.

    HTH
    Cross-poster? Read this: Cross-posters
    Struggling to use tags (including Code tags)? : Forum tags

  3. #3
    Join Date
    18th February 2003
    Posts
    24
    Thanks for the response. I was not aware of the cross posting policy, will try to follow it in the future.

    After further investigation, there does not appear to be a clear method to obtain the Excel Product Id Key from the registry due to the many variations in the registry format for the different Excel installations.

    Due to the variations in the registry format, I will follow your suggestion and use the C: drive serial number for the licensing. This will require a new license whenever the C: drive is swapped out but that is acceptable for my usage.

    I also noticed the drive serial number obtained programmatically does not match the serial number on the disk drive box. This may be a result of converting the text number on the box to a 9-10 digit decimal number. As long as the serial number is a unique identifier then it should be ok for my usage. I'll provide a small utility to the users which they can run to obtain their disk serial number.

    thanks.

    Excel Video Tutorials / Excel Dashboards Reports


Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Possible Answers

  1. product says value
    By DaveR (UK) in forum EXCEL HELP
    Replies: 3
    Last Post: June 8th, 2006, 20:01
  2. PRODUCT shows a value even if 0*#
    By Dave Hawley in forum EXCEL HELP
    Replies: 2
    Last Post: June 8th, 2006, 18:55
  3. Product VBA
    By mini12 in forum EXCEL HELP
    Replies: 4
    Last Post: July 22nd, 2005, 21:29
  4. Product VBA
    By mini12 in forum EXCEL HELP
    Replies: 20
    Last Post: July 16th, 2005, 06:46
  5. Product VBA
    By mini12 in forum EXCEL HELP
    Replies: 13
    Last Post: July 10th, 2005, 09:02

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
porno