How to check the activation status of MS Office

kelly mort

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
2,169
Office Version
  1. 2016
Platform
  1. Windows
Hello and Happy new year,

I am looking for a way to check the activation status of Microsoft Office when ever I open my workbook.

If that is possible with vba, can someone show me the way to go?

Thanks and have a great moment.
 
Sort by date Sort by votes
If office is not activated, the main excel window caption displays the text : "Product Activation Failed" (Guess this text is language dependent)
You can take advantage of this and write a little function to check the excel activation status.

VBA Code: 
Function IsExcelLicenceActivated() As Boolean
    IsExcelLicenceActivated = InStr(1, Application.Caption, "Product Activation Failed", vbTextCompare) = 0
End Function


For a more sophisticated way that will offer more detailed statuses such as Licensed, UnLicensed, OOB_GRACE, NOTIFICATIONS ...etc , I have used a batch file to execute the ospp.vbs command-line. According to the doc, you need admin rights for this.

One issue I have found with this method when testing is that it can sometimes be slow in a sporadic manner so I have optionally added the possibility to keep the user updated of the progress of the processing via the StatusBar ( you can easily adapt the code and use a userform instead)

Anyway, give this a go and see what happens.

This is the code :
VBA Code: 
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
Private i As Long

Function GetExcelActivationStatus() As String

    Dim FileNum As Integer
    Dim sBatFile As String
    Dim sBatFileOutPut   As String
    Dim sCommand As String
    Dim DataLine As String
    Dim sStatus As String
    Dim WshShell As Object
 
    sBatFile = ThisWorkbook.Path & "\temp.bat"
    sBatFileOutPut = ThisWorkbook.Path & "\temp.txt"
 
    With Application
        sCommand = "CD ""%SystemDrive%\" & Right(.Path, Len(.Path) - InStr(.Path, "\"))
    End With
 
    'It may take a little while to execute the batch file.
    'so you may want to update the user of the ongoing processing.
    'This is optional, so you can comment out the following line if feedback is not wanted.
    SetTimer Application.hwnd, 0, 1000, AddressOf ProcessingFeedBack
 
    FileNum = FreeFile()
    Open sBatFile For Output As #FileNum
        Print #FileNum, "@echo on"
        Print #FileNum, sCommand
        Print #FileNum, "cscript ospp.vbs /dstatus> " & sBatFileOutPut
    Close #FileNum
 
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.Run sBatFile, 0, True
 
    FileNum = FreeFile()
    Open sBatFileOutPut For Input As #FileNum
        While Not EOF(FileNum)
            Line Input #FileNum, DataLine
            If InStr(1, DataLine, "LICENSE STATUS:", vbTextCompare) Then
                sStatus = Replace(DataLine, "LICENSE STATUS:", "")
                sStatus = Trim(Replace(sStatus, "-", ""))
            End If
        Wend
    Close #FileNum
 
    KillTimer Application.hwnd, 0
    i = 0
    Application.StatusBar = False
    Set WshShell = Nothing
    Kill sBatFile
    Kill sBatFileOutPut
    GetExcelActivationStatus = sStatus

End Function

Sub ProcessingFeedBack()
    On Error Resume Next
    Application.StatusBar = "Processing" & String((i Mod 3) + 1, ".")
    i = i + 1
End Sub

VBA Code: 
Sub test()
    MsgBox GetExcelActivationStatus
End Sub
 
Last edited:
Upvote 0
Solution
Hello @Jaafar Tribak
Thanks for the code. It has been a while. I hope you are doing well.

I ran the code, the message box showed blank string.

I turned off the killing of the files and I think there was an error.
Have a look:
error_code.jpg
 
Upvote 0
Hi Kelly,

That error is saying the ospp.vbs file doesn't exist in the office16 folder which is supposed to be the default installation directory. I am not sure why this is happening. Maybe the vbs file was moved from Office's original installed location or deleted.

I guess you have Office x32bit on a Win64 bit OS.

Late edit:
Did you try the first method (IsExcelLicenceActivated function) which simply reads the application caption ?
Isn't that method good enough for your purposes ?
 
Upvote 0
Oh okay.
It's true I am having 32 bit office installed on 64 bit system.

I have now tried the first method and it's cooler.
Thanks.
 
Upvote 0
Try the following, It replaces a portion of the original code from post #2

VBA Code: 
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
Private i As Long

Sub test()
    MsgBox GetExcelActivationStatus
End Sub

Function GetExcelActivationStatus() As String

    Dim FileNum As Integer
    Dim sBatFile As String
    Dim sBatFileOutPut   As String
    Dim sCommand As String
    Dim DataLine As String
    Dim sStatus As String
    Dim WshShell As Object
 
    sBatFile = ThisWorkbook.Path & "\temp.bat" 
    sBatFileOutPut = ThisWorkbook.Path & "\temp.txt"
 
    With Application
''        sCommand = "CD ""%SystemDrive%\" & Right(.Path, Len(.Path) - InStr(.Path, "\"))   ' %SystemDrive% is not correct ;)
'
        sCommand = "CD " & Environ("SystemDrive") & "\" & Right(.Path, Len(.Path) - InStr(.Path, "\"))
'
'--------
'
        If sCommand = "CD C:\Program Files (x86)\Microsoft Office\root\Office16" Then ' Office 2016/2019 32/64 bit 32/64 bit office/windows check ie. 32 to 32 or 64 to 64
            sCommand = "CD C:\Program Files (x86)\Microsoft Office\Office16"
        End If
        If sCommand = "CD C:\Program Files\Microsoft Office\root\Office16" Then         ' Office 2016/2019 32/64 bit check ... Guessing at this one, can't test it
            sCommand = "CD C:\Program Files\Microsoft Office\Office16"
        End If
'
'--------
'
    End With
 
    'It may take a little while to execute the batch file.
    'so you may want to update the user of the ongoing processing.
    'This is optional, so you can comment out the following line if feedback is not wanted.
    SetTimer Application.hwnd, 0, 1000, AddressOf ProcessingFeedBack
 
    FileNum = FreeFile()                                                                ' 1
    Open sBatFile For Output As #FileNum
        Print #FileNum, "@echo on"
        Print #FileNum, sCommand
        Print #FileNum, "cscript ospp.vbs /dstatus> " & sBatFileOutPut
    Close #FileNum
 
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.Run sBatFile, 0, True
 
    FileNum = FreeFile()
    Open sBatFileOutPut For Input As #FileNum
        While Not EOF(FileNum)
            Line Input #FileNum, DataLine
            If InStr(1, DataLine, "LICENSE STATUS:", vbTextCompare) Then
                sStatus = Replace(DataLine, "LICENSE STATUS:", "")
                sStatus = Trim(Replace(sStatus, "-", ""))
            End If
        Wend
    Close #FileNum
 
    KillTimer Application.hwnd, 0
    i = 0
    Application.StatusBar = False
    Set WshShell = Nothing
    Kill sBatFile
    Kill sBatFileOutPut
    GetExcelActivationStatus = sStatus

End Function

Sub ProcessingFeedBack()
    On Error Resume Next
    Application.StatusBar = "Processing" & String((i Mod 3) + 1, ".")
    i = i + 1
End Sub

The code will not work for office 2007, but for 2010 and up I am hopeful.
 
Upvote 0
@johnnyL

Good catch!
Just tested the code with the Environ("SystemDrive") and it worked ok.
I used the %SystemDrive% as per the doc recommendation.

In fact, thinking about it , the following simpler line will generate the same bat script and works as well.
VBA Code: 
sCommand = "CD " & Application.Path

BTW, when you tested the code, did the function take a while before returning the activation status ?

Thanks
 
Upvote 0
About 20 seconds for 32 bit Office 2016 on Windows 7 64 bit
 
Upvote 0
@johnnyL
I am getting the same error I had with @Jaafar Tribak 's code.

For now I will be using his first code as that is faster to get me what I want to do.

But for future usage, why is it failing at my end?
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
When I copy the excel file to another windows partition, it's not working
Replies
1
Views
164
ranman256
ranman256
B
  • Question Question
Insert Picture (or Image) in a Cell
Replies
1
Views
184
Sergius
S
G
  • Question Question
Best or only version of Excel for this purpose
Replies
2
Views
222
ginotx
G
P
  • Solved
Excel F8 - Shut Down PC
2
Replies
14
Views
406
Pacman52
P
V
  • Question Question
Disallowing user to change cell color
Replies
5
Views
224
Logit
Logit

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top