Solved where is office 2013 office product key stored?

July 28, 2015 at 09:18:13
Specs: Windows 7 Pro
have a computer with a preinstalled version of office 2013 and I want to reimage the computer.

used to be that magical jelly bean would provide the key... not so with office 2013

where will I find the key on the computer?


See More: where is office 2013 office product key stored?

Report •


✔ Best Answer
July 29, 2015 at 01:13:50
You can try this vbs code: it finds Windows and Office keys, it seems to find my office 2013 key correctly.

Copy paste the code into Notepad
File >> SaveAs
Change 'Save as type' to 'All Files'
Enter a filename and save

Then double click and a txt file will be saved in the same location to where the vbs file is

Const HKLM = &H80000002

dim fso: set fso = CreateObject("Scripting.FileSystemObject")
    dim CurrentDirectory
    CurrentDirectory = fso.GetAbsolutePathName(".")


Set objFileToWrite = CreateObject("Scripting.FileSystemObject").OpenTextFile(CurrentDirectory & "\OfficeKeys.txt",8,True)

'wscript.echo "View Product Keys | Microsoft Products" & vbCrLf

'Install Date 
Computer = "."
Set objWMIService = GetObject("winmgmts:\\" & Computer & "\root\cimv2")
Set Obj = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")

dim InsDate

For Each item in Obj
  InsDate = item.InstallDate
  ' Gather Operating System Information
  Caption = Item.Caption
  OSArchitecture = Item.OSArchitecture
  CSDVersion = Item.CSDVersion
  Version = Item.Version
  Next

dim NewDate

NewDate = mid(InsDate,9,2) & ":" & mid(InsDate,11,2) & ":" & mid(InsDate,13,2)
NewDate = NewDate & " " & mid(InsDate,7,2) & "/" & mid(InsDate,5,2) & "/" & mid(InsDate,1,4)

QueryWindowsProductKeys() 

'wscript.echo 'vbCrLf & "Office Keys" & vbCrLf

QueryOfficeProductKeys()

Function DecodeProductKey(arrKey, intKeyOffset)
  If Not IsArray(arrKey) Then Exit Function
    intIsWin8 = BitShiftRight(arrKey(intKeyOffset + 14),3) And 1    
    arrKey(intKeyOffset + 14) = arrKey(intKeyOffset + 14) And 247 Or BitShiftLeft(intIsWin8 And 2,2)
    i = 24
    strChars = "BCDFGHJKMPQRTVWXY2346789"
    strKeyOutput = ""
    While i > -1
        intCur = 0
        intX = 14
        While intX > -1
            intCur = BitShiftLeft(intCur,8)
            intCur = arrKey(intX + intKeyOffset) + intCur
            arrKey(intX + intKeyOffset) = Int(intCur / 24) 
            intCur = intCur Mod 24
            intX = intX - 1
        Wend
        i = i - 1
        strKeyOutput = Mid(strChars,intCur + 1,1) & strKeyOutput
        intLast = intCur
    Wend
    If intIsWin8 = 1 Then
        strKeyOutput = Mid(strKeyOutput,2,intLast) & "N" & Right(strKeyOutput,Len(strKeyOutput) - (intLast + 1))    
    End If
    strKeyGUIDOutput = Mid(strKeyOutput,1,5) & "-" & Mid(strKeyOutput,6,5) & "-" & Mid(strKeyOutput,11,5) & "-" & Mid(strKeyOutput,16,5) & "-" & Mid(strKeyOutput,21,5)
    DecodeProductKey = strKeyGUIDOutput
End Function

Function RegReadBinary(strRegPath,strRegValue)
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    objReg.GetBinaryValue HKLM,strRegPath,strRegValue,arrRegBinaryData
    RegReadBinary = arrRegBinaryData
    Set objReg = Nothing
End Function

Function BitShiftLeft(intValue,intShift)
    BitShiftLeft = intValue * 2 ^ intShift
End Function

Function BitShiftRight(intValue,intShift)
    BitShiftRight = Int(intValue / (2 ^ intShift))
End Function

Function QueryOfficeProductKeys()

        strBaseKey = "SOFTWARE\"

        strOfficeKey = strBaseKey & "Microsoft\Office"
        Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
        objReg.EnumKey HKLM, strOfficeKey, arrOfficeVersionSubKeys
        intProductCount = 1
        If IsArray(arrOfficeVersionSubKeys) Then

            For Each strOfficeVersionKey In arrOfficeVersionSubKeys

                Select Case strOfficeVersionKey
                    Case "11.0"
                        CheckOfficeKey strOfficeKey & "\11.0\Registration",52,intProductCount
                    Case "12.0"
                        CheckOfficeKey strOfficeKey & "\12.0\Registration",52,intProductCount
                    Case "14.0"
                        CheckOfficeKey strOfficeKey & "\14.0\Registration",808,intProductCount
                    Case "15.0"
                        CheckOfficeKey strOfficeKey & "\15.0\Registration",808,intProductCount
                End Select
            Next
        End If

        strBaseKey = "SOFTWARE\Wow6432Node\"

        strOfficeKey = strBaseKey & "Microsoft\Office"
        Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
        objReg.EnumKey HKLM, strOfficeKey, arrOfficeVersionSubKeys
        intProductCount = 1

        If IsArray(arrOfficeVersionSubKeys) Then

            For Each strOfficeVersionKey In arrOfficeVersionSubKeys

                Select Case strOfficeVersionKey
                    Case "11.0"
                        CheckOfficeKey strOfficeKey & "\11.0\Registration",52,intProductCount
                    Case "12.0"
                        CheckOfficeKey strOfficeKey & "\12.0\Registration",52,intProductCount
                    Case "14.0"
                        CheckOfficeKey strOfficeKey & "\14.0\Registration",808,intProductCount
                    Case "15.0"
                        CheckOfficeKey strOfficeKey & "\15.0\Registration",808,intProductCount
                End Select
            Next
        End If
End Function

'Office Product Key
Sub CheckOfficeKey(strRegPath,intKeyOffset,intProductCount)

    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    objReg.EnumKey HKLM, strRegPath, arrOfficeRegistrations
    If IsArray(arrOfficeRegistrations) Then
        For Each strOfficeRegistration In arrOfficeRegistrations

            objReg.GetStringValue HKLM,strRegPath & "\" & strOfficeRegistration,"ConvertToEdition",strOfficeEdition
            objReg.GetBinaryValue HKLM,strRegPath & "\" & strOfficeRegistration,"DigitalProductID",arrProductID
            If strOfficeEdition <> "" And IsArray(arrProductID) Then
                WriteData "Product", strOfficeEdition
                WriteData "Key", DecodeProductKey(arrProductID,intKeyOffset) & vbCrLf
                intProductCount = intProductCount + 1
            End If
        Next
    End If
End Sub


'Windows Product Key
Sub QueryWindowsProductKeys()
    strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion","DigitalProductId",52)
    If strWinKey <> "" Then
        WriteData "Product: " & Caption & Version & " (" & OSArchitecture & ")", ""
        'WriteData "Installation Date: " & NewDate 
        WriteData "Key", strWinKey & vbnewline
        Exit Sub
    End If
    strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion","DigitalProductId4",808)
    If strWinKey <> "" Then
        WriteData "Product: " & Caption & Version & " (" & OSArchitecture & ")", ""
        'WriteData "Installation Date: " & NewDate
        WriteData "Key", strWinKey & vbnewline
        Exit Sub
    End If
    strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductKey","DigitalProductId",52)
    If strWinKey <> "" Then 
        WriteData "Product: " & Caption & Version & " (" & OSArchitecture & ")", ""
        'WriteData"Installation Date: " & NewDate
        WriteData "Key", strWinKey & vbnewline
        Exit Sub
    End If
    strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductKey","DigitalProductId4",808)
    If strWinKey <> "" Then
        WriteData "Product: " & Caption & Version & " (" & OSArchitecture & ")", ""
        'WriteData "Installation Date: " & NewDate
        WriteData "Key", strWinKey & vbnewline
        Exit Sub
    End If
	
	

End Sub


Function CheckWindowsKey(strRegPath,strRegValue,intKeyOffset)
    strWinKey = DecodeProductKey(RegReadBinary(strRegPath,strRegValue),intKeyOffset)
    If strWinKey <> "BBBBB-BBBBB-BBBBB-BBBBB-BBBBB" And strWinKey <> "" Then
        CheckWindowsKey = strWinKey
    Else
        CheckWindowsKey = ""
    End If
End Function

Function RegReadBinary(strRegPath,strRegValue)
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    objReg.GetBinaryValue HKLM,strRegPath,strRegValue,arrRegBinaryData
    RegReadBinary = arrRegBinaryData
    Set objReg = Nothing
End Function

Function OsArch()
    Set objShell = WScript.CreateObject("WScript.Shell")
    If objShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%") = "%ProgramFiles(x86)%" Then
        OsArch = "x86" 
    Else
        OsArch = "x64"
    End If
    Set objShell = Nothing
End Function

Sub WriteData(strProperty,strValue)

    objFileToWrite.WriteLine strProperty & ": " & Trim(strValue)

    'Set objShell = CreateObject("WScript.Shell")
    'strKey = "HKLM\SOFTWARE\CentraStage\Custom\" & strProperty
    'objShell.RegWrite strKey,Trim(strValue),"REG_SZ"
    'Set objShell = Nothing

End Sub

wscript.echo "Successfully Saved"

message edited by AlwaysWillingToLearn



#1
July 28, 2015 at 10:08:21
If you restore to Factory Settings (there should be a restore partition on the HDD,) you shouldn't need the key to run Office.

Report •

#2
July 28, 2015 at 10:15:36
k, thanks.

I'm curious, if I'm upgrading to a solid state hard drive or something like that, there has to be a location on the computer where the key is stored


Report •

#3
July 28, 2015 at 10:40:21

Report •

Related Solutions

#4
July 28, 2015 at 13:35:50
This shows my keys including office:
http://www.belarc.com/free_download...

Always pop back and let us know the outcome - thanks


Report •

#5
July 28, 2015 at 13:41:04
I didn't think that Belarc shows the key for office 2013

Report •

#6
July 28, 2015 at 14:42:50
A couple more ways... likely along the same lines as earlier?

http://tinyurl.com/p4ej6uk

http://tinyurl.com/no862qh

message edited by trvlr


Report •

#7
July 29, 2015 at 01:13:50
✔ Best Answer
You can try this vbs code: it finds Windows and Office keys, it seems to find my office 2013 key correctly.

Copy paste the code into Notepad
File >> SaveAs
Change 'Save as type' to 'All Files'
Enter a filename and save

Then double click and a txt file will be saved in the same location to where the vbs file is

Const HKLM = &H80000002

dim fso: set fso = CreateObject("Scripting.FileSystemObject")
    dim CurrentDirectory
    CurrentDirectory = fso.GetAbsolutePathName(".")


Set objFileToWrite = CreateObject("Scripting.FileSystemObject").OpenTextFile(CurrentDirectory & "\OfficeKeys.txt",8,True)

'wscript.echo "View Product Keys | Microsoft Products" & vbCrLf

'Install Date 
Computer = "."
Set objWMIService = GetObject("winmgmts:\\" & Computer & "\root\cimv2")
Set Obj = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")

dim InsDate

For Each item in Obj
  InsDate = item.InstallDate
  ' Gather Operating System Information
  Caption = Item.Caption
  OSArchitecture = Item.OSArchitecture
  CSDVersion = Item.CSDVersion
  Version = Item.Version
  Next

dim NewDate

NewDate = mid(InsDate,9,2) & ":" & mid(InsDate,11,2) & ":" & mid(InsDate,13,2)
NewDate = NewDate & " " & mid(InsDate,7,2) & "/" & mid(InsDate,5,2) & "/" & mid(InsDate,1,4)

QueryWindowsProductKeys() 

'wscript.echo 'vbCrLf & "Office Keys" & vbCrLf

QueryOfficeProductKeys()

Function DecodeProductKey(arrKey, intKeyOffset)
  If Not IsArray(arrKey) Then Exit Function
    intIsWin8 = BitShiftRight(arrKey(intKeyOffset + 14),3) And 1    
    arrKey(intKeyOffset + 14) = arrKey(intKeyOffset + 14) And 247 Or BitShiftLeft(intIsWin8 And 2,2)
    i = 24
    strChars = "BCDFGHJKMPQRTVWXY2346789"
    strKeyOutput = ""
    While i > -1
        intCur = 0
        intX = 14
        While intX > -1
            intCur = BitShiftLeft(intCur,8)
            intCur = arrKey(intX + intKeyOffset) + intCur
            arrKey(intX + intKeyOffset) = Int(intCur / 24) 
            intCur = intCur Mod 24
            intX = intX - 1
        Wend
        i = i - 1
        strKeyOutput = Mid(strChars,intCur + 1,1) & strKeyOutput
        intLast = intCur
    Wend
    If intIsWin8 = 1 Then
        strKeyOutput = Mid(strKeyOutput,2,intLast) & "N" & Right(strKeyOutput,Len(strKeyOutput) - (intLast + 1))    
    End If
    strKeyGUIDOutput = Mid(strKeyOutput,1,5) & "-" & Mid(strKeyOutput,6,5) & "-" & Mid(strKeyOutput,11,5) & "-" & Mid(strKeyOutput,16,5) & "-" & Mid(strKeyOutput,21,5)
    DecodeProductKey = strKeyGUIDOutput
End Function

Function RegReadBinary(strRegPath,strRegValue)
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    objReg.GetBinaryValue HKLM,strRegPath,strRegValue,arrRegBinaryData
    RegReadBinary = arrRegBinaryData
    Set objReg = Nothing
End Function

Function BitShiftLeft(intValue,intShift)
    BitShiftLeft = intValue * 2 ^ intShift
End Function

Function BitShiftRight(intValue,intShift)
    BitShiftRight = Int(intValue / (2 ^ intShift))
End Function

Function QueryOfficeProductKeys()

        strBaseKey = "SOFTWARE\"

        strOfficeKey = strBaseKey & "Microsoft\Office"
        Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
        objReg.EnumKey HKLM, strOfficeKey, arrOfficeVersionSubKeys
        intProductCount = 1
        If IsArray(arrOfficeVersionSubKeys) Then

            For Each strOfficeVersionKey In arrOfficeVersionSubKeys

                Select Case strOfficeVersionKey
                    Case "11.0"
                        CheckOfficeKey strOfficeKey & "\11.0\Registration",52,intProductCount
                    Case "12.0"
                        CheckOfficeKey strOfficeKey & "\12.0\Registration",52,intProductCount
                    Case "14.0"
                        CheckOfficeKey strOfficeKey & "\14.0\Registration",808,intProductCount
                    Case "15.0"
                        CheckOfficeKey strOfficeKey & "\15.0\Registration",808,intProductCount
                End Select
            Next
        End If

        strBaseKey = "SOFTWARE\Wow6432Node\"

        strOfficeKey = strBaseKey & "Microsoft\Office"
        Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
        objReg.EnumKey HKLM, strOfficeKey, arrOfficeVersionSubKeys
        intProductCount = 1

        If IsArray(arrOfficeVersionSubKeys) Then

            For Each strOfficeVersionKey In arrOfficeVersionSubKeys

                Select Case strOfficeVersionKey
                    Case "11.0"
                        CheckOfficeKey strOfficeKey & "\11.0\Registration",52,intProductCount
                    Case "12.0"
                        CheckOfficeKey strOfficeKey & "\12.0\Registration",52,intProductCount
                    Case "14.0"
                        CheckOfficeKey strOfficeKey & "\14.0\Registration",808,intProductCount
                    Case "15.0"
                        CheckOfficeKey strOfficeKey & "\15.0\Registration",808,intProductCount
                End Select
            Next
        End If
End Function

'Office Product Key
Sub CheckOfficeKey(strRegPath,intKeyOffset,intProductCount)

    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    objReg.EnumKey HKLM, strRegPath, arrOfficeRegistrations
    If IsArray(arrOfficeRegistrations) Then
        For Each strOfficeRegistration In arrOfficeRegistrations

            objReg.GetStringValue HKLM,strRegPath & "\" & strOfficeRegistration,"ConvertToEdition",strOfficeEdition
            objReg.GetBinaryValue HKLM,strRegPath & "\" & strOfficeRegistration,"DigitalProductID",arrProductID
            If strOfficeEdition <> "" And IsArray(arrProductID) Then
                WriteData "Product", strOfficeEdition
                WriteData "Key", DecodeProductKey(arrProductID,intKeyOffset) & vbCrLf
                intProductCount = intProductCount + 1
            End If
        Next
    End If
End Sub


'Windows Product Key
Sub QueryWindowsProductKeys()
    strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion","DigitalProductId",52)
    If strWinKey <> "" Then
        WriteData "Product: " & Caption & Version & " (" & OSArchitecture & ")", ""
        'WriteData "Installation Date: " & NewDate 
        WriteData "Key", strWinKey & vbnewline
        Exit Sub
    End If
    strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion","DigitalProductId4",808)
    If strWinKey <> "" Then
        WriteData "Product: " & Caption & Version & " (" & OSArchitecture & ")", ""
        'WriteData "Installation Date: " & NewDate
        WriteData "Key", strWinKey & vbnewline
        Exit Sub
    End If
    strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductKey","DigitalProductId",52)
    If strWinKey <> "" Then 
        WriteData "Product: " & Caption & Version & " (" & OSArchitecture & ")", ""
        'WriteData"Installation Date: " & NewDate
        WriteData "Key", strWinKey & vbnewline
        Exit Sub
    End If
    strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductKey","DigitalProductId4",808)
    If strWinKey <> "" Then
        WriteData "Product: " & Caption & Version & " (" & OSArchitecture & ")", ""
        'WriteData "Installation Date: " & NewDate
        WriteData "Key", strWinKey & vbnewline
        Exit Sub
    End If
	
	

End Sub


Function CheckWindowsKey(strRegPath,strRegValue,intKeyOffset)
    strWinKey = DecodeProductKey(RegReadBinary(strRegPath,strRegValue),intKeyOffset)
    If strWinKey <> "BBBBB-BBBBB-BBBBB-BBBBB-BBBBB" And strWinKey <> "" Then
        CheckWindowsKey = strWinKey
    Else
        CheckWindowsKey = ""
    End If
End Function

Function RegReadBinary(strRegPath,strRegValue)
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    objReg.GetBinaryValue HKLM,strRegPath,strRegValue,arrRegBinaryData
    RegReadBinary = arrRegBinaryData
    Set objReg = Nothing
End Function

Function OsArch()
    Set objShell = WScript.CreateObject("WScript.Shell")
    If objShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%") = "%ProgramFiles(x86)%" Then
        OsArch = "x86" 
    Else
        OsArch = "x64"
    End If
    Set objShell = Nothing
End Function

Sub WriteData(strProperty,strValue)

    objFileToWrite.WriteLine strProperty & ": " & Trim(strValue)

    'Set objShell = CreateObject("WScript.Shell")
    'strKey = "HKLM\SOFTWARE\CentraStage\Custom\" & strProperty
    'objShell.RegWrite strKey,Trim(strValue),"REG_SZ"
    'Set objShell = Nothing

End Sub

wscript.echo "Successfully Saved"

message edited by AlwaysWillingToLearn


Report •


Ask Question