Link to home
Start Free TrialLog in
Avatar of ajmcqueen
ajmcqueen

asked on

Office 2013 Product Key

Trying to recover an Office 2013 Product Key from Windows 7 upgraded to Windows 10.
The Office 2013 was purchased OEM with a DELL PC and product key originally entered from accompanying card.
Avatar of Professor J
Professor J

you can put this code in notepad then save it with extention of vbs and then open it

it will show you the keys.

Const HKLM = &H80000002

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
		wscript.echo "Product: " & Caption & Version & " (" & OSArchitecture & ")"
		wscript.echo "Installation Date: " & NewDate 
		WriteData "Key", strWinKey
		Exit Sub
	End If
	strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion","DigitalProductId4",808)
	If strWinKey <> "" Then
		wscript.echo "Product: " & Caption & Version & " (" & OSArchitecture & ")"
		wscript.echo "Installation Date: " & NewDate
		WriteData "Key", strWinKey
		Exit Sub
	End If
	strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductKey","DigitalProductId",52)
	If strWinKey <> "" Then
		wscript.echo "Product: " & Caption & Version & " (" & OSArchitecture & ")"
		wscript.echo "Installation Date: " & NewDate
		WriteData "Key", strWinKey
		Exit Sub
	End If
	strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductKey","DigitalProductId4",808)
	If strWinKey <> "" Then
		wscript.echo "Product: " & Caption & Version & " (" & OSArchitecture & ")"
		wscript.echo "Installation Date: " & NewDate
		WriteData "Key", strWinKey
		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)
	
	WScript.Echo 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

Open in new window

Though your script shows product keys they don't match the product keys on my system.
or you can try this.

Const HKEY_LOCAL_MACHINE = &H80000002
 WinKey = GetWinKey
 OfficeKeys = GetOfficeKey("10.0") & GetOfficeKey("11.0") & GetOfficeKey("12.0") & GetOfficeKey("14.0") & GetOfficeKey("15.0")
 
If Msgbox(WinKey & vbnewline & vbnewline & OfficeKeys & vbnewline & "Save All Keys to ProductKeys.txt?", vbyesno, "Cosmic Boom") = vbyes then
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     Set objTextFile = objFSO.CreateTextFile("ProductKeys.txt", True)
     objTextFile.Write WinKey & vbnewline & vbnewline & OfficeKeys
     objTextFile.Close
 end if
 
Function GetOfficeKey(sVer)
     On Error Resume Next
     Dim arrSubKeys
     Set wshShell = WScript.CreateObject( "WScript.Shell" )
     sBit = wshShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%")
     if sBit <> "%ProgramFiles(x86)%" then
    sBit = "Software\wow6432node"
     else
    sBit = "Software"
     end if
     Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
     objReg.EnumKey HKEY_LOCAL_MACHINE, sBit & "\Microsoft\Office\" & sVer & "\Registration", arrSubKeys
     Set objReg = Nothing
     if IsNull(arrSubKeys) = False then
         For Each Subkey in arrSubKeys
        if lenb(other) < 1 then other = wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\ProductName")
        if ucase(right(SubKey, 7)) = "0FF1CE}" then
                 Set wshshell = CreateObject("WScript.Shell")
            key = ConvertToKey(wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\DigitalProductID"))
       oem = ucase(mid(wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\ProductID"), 7, 3))
         edition = wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\ProductName")
       if err.number <> 0 then 
           edition = other
                    err.clear
       end if
            Set wshshell = Nothing
             if oem <> "OEM" then oem = "Retail"
            if lenb(final) > 1 then
           final = final & vbnewline & final
              else
                final = edition & " " & oem & ":  " & key 
                 end if
        end if
         Next
    GetOfficeKey = final & vbnewline
     End If
 End Function
 
Function GetWinKey()
     Set wshshell = CreateObject("WScript.Shell")
     edition = wshshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName")
     oem = ucase(mid(wshshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductID"), 7, 3))
     key = GetKey("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")
     set wshshell = Nothing
     if oem <> "OEM" then oem = "Retail"
     GetWinKey = edition & " " & oem & ":  " & key
 End Function
 
Function GetKey(sReg)
     Set wshshell = CreateObject("WScript.Shell")
     GetKey = ConvertToKey(wshshell.RegRead(sReg))
     Set wshshell = Nothing
 End Function
 
Function ConvertToKey(key)
     Const KeyOffset = 52
     i = 28
     Chars = "BCDFGHJKMPQRTVWXY2346789"
     Do
         Cur = 0
         x = 14
         Do
             Cur = Cur * 256
             Cur = key(x + KeyOffset) + Cur
             key(x + KeyOffset) = (Cur \ 24) And 255
             Cur = Cur Mod 24
             x = x - 1
         Loop While x >= 0
         i = i - 1
         KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
         If (((29 - i) Mod 6) = 0) And (i <> -1) Then
             i = i - 1
             KeyOutput = "-" & KeyOutput
         End If
     Loop While i >= 0
     ConvertToKey = KeyOutput
 End Function

Open in new window

Finding your Office 2013 product key
Purchasers of Office 2013 usually receive only a Product Key Card and instructions to download office from the office.com web site.  The 25 character key on that Product Key Card is not your office install key, but instead an entitlement key allowing you to install office from that web site.

You can see the product key that is used to install office by signing into your office.com account here.  Once signed in, choose Install from a disc under Account Options.  You'll see your office installation product key to the right of your options.
http://www.belarc.com/msproductkeys.html
Avatar of ajmcqueen

ASKER

None of the above work with Office 2013 or apply to Office 2013 OEM.
well this http://www.nsauditor.com/downloads/#.VqUp8_krLIU   garantees it does work for office 2013. well you might wanna start with a trial version, as it is not free.
ASKER CERTIFIED SOLUTION
Avatar of ajmcqueen
ajmcqueen

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
None of the other suggestions worked.