There might be situations when you would like to set a trial period for your Excel applications: maybe you want to prevent employees take the applications and use them forever in other places after they leave your company or you simply need to provide to a client a trial that can be tested only a limited period.
How can we achieve this in Excel ? A question that I asked myself many times…
One solution that I wrote, can be the following:
- Every time the workbook or Add-in file is opened, the current date is checked. In the Workbook_Open trigger of your file input a code that will check if the current date is greater than the date set-up in the VBA code as expiration date. If the expression is TRUE, the user will be informed with a message that the Application with the name “your name” has expired. Please contact the Administrator to renew the version… In the same time the file is permanently deleted from the user’s computer 🙂
- If desired you can implement a feature that will also inform the user, every time he opens the application, how many days he has left until the version expires.
The place where you need to copy the code:
The code that will permanently delete the file after the date set-up in the back-end is passed.
Private Sub Workbook_Open() Dim exdate As Date Dim i As Integer 'modify values for expiration date here !!! anul = 2015 'year luna = 11 'month ziua = 1 'day exdate = DateSerial(anul, luna, ziua) If Date > exdate Then MsgBox ("The application " & ThisWorkbook.Name & " has expired !" & vbNewLine & vbNewLine _ & "Expiration set up date is: " & exdate & " :)" & vbNewLine & vbNewLine _ & "Contact Administrator to renew the version !"), vbCritical, ThisWorkbook.Name expired_file = ThisWorkbook.Path & "\" & ThisWorkbook.Name On Error GoTo ErrorHandler With Workbooks(ThisWorkbook.Name) If .Path <> "" Then .Saved = True .ChangeFileAccess xlReadOnly Kill expired_file 'get the name of the addin if it is addin and unistall addin If Application.Version >= 12 Then i = 5 Else: i = 4 End If If Right(ThisWorkbook.Name, i) = ".xlam" Or Right(ThisWorkbook.Name, i) = ".xla" Then wbName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - i) 'uninstall addin if it is installed If AddIns(wbName).Installed Then AddIns(wbName).Installed = False End If End If .Close End If End With Exit Sub End If 'MsgBox ("You have " & exdate - Date & "Days left") Exit Sub ErrorHandler: MsgBox "Fail to delete file.. " Exit Sub End Sub
! If the current date is greater than the date from the code, the user receives the below error and the file is deleted forever 🙂
* Before using the above code please make sure that you create a backup of the original file without the protection code and you set-up the “Expiration Date” parameters in future.
!!! Do not forget to protect your VBA code with a password. Otherwise, users will be able to see and delete the code. To protect a VBA project, follow these steps.
–> This is a solution, but not a perfect one… A better solution would be to check the computer of user and if that computer is not one provided by the company, the application cannot be opened. You will also have an expiration date for the file in case there are users that will “get the trick” and change their computer names 🙂
To get the computer name you can use this:
Dim CompName As String 'Get Computer Name CompName = Environ$("computername") MsgBox CompName
You can then check if the CompName follows the naming pattern of the computers from your organization.
A third solution: you can ask the user to provide a key first time he opens your application. If the provided key is equal to the key from your code, store it in a hidden sheet TRUE in a column named “Key Activated”. Then check if “Key Activated” is TRUE, and if yes, the user can open the file, if not, close the file.. You must combine this with the computer name. Every time the file is opened, check the computer name, and if it is a new computer, ask again for the key. If the user provides the correct key, store also that combination of computer name and “Key Activated” TRUE.
I am sure that there can be implemented more solutions.. If you know a better one, please share it in comment !