Trail period and activation key in VBA

Anything can be broken into, no matter the language.

My thoughts would be to to use VBComponents and upon 30 days reached deletes all modules in the workbook. That way they would have to contact you again for the working work book.

Thanks for your reply.

The thing is that my workbook also acts as a database, so all the data that they generate using my file should not be deleted if they are a little bit late in paying...
But I guess that's something to look into for maybe >90 days without payment or so.

In the meantime I wrote some code that seems to do the trick:

Sub Workbook_Open()
    Dim exdate As Date
    exdate = "04/22/2016"
    If Date > exdate And Sheet11.Cells(1, 1) <> "code" Then
        activation = InputBox("Please enter the activation key provided to you after payment:")
            If activation = "code" Then
            Sheet11.Cells(1, 1) = activation
            Else
            ActiveWorkbook.Close savechanges:=False
            End If
    Else
    
    End If
  
End Sub

So it checks the expiration date and if the password is written in a certain cell.
If it's expired and the code is not there, then the user has to enter the key.
If it's the same, the file is unlocked.
I guess this will keep the majority of my clients with a locked file.

Does anyone see any major flaws in this?

Originally Posted by Exelance

Thanks for your reply.

The thing is that my workbook also acts as a database, so all the data that they generate using my file should not be deleted if they are a little bit late in paying...
But I guess that's something to look into for maybe >90 days without payment or so.

In the meantime I wrote some code that seems to do the trick:

Sub Workbook_Open()
    Dim exdate As Date
    exdate = "04/22/2016"
    If Date > exdate And Sheet11.Cells(1, 1) <> "code" Then
        activation = InputBox("Please enter the activation key provided to you after payment:")
            If activation = "code" Then
            Sheet11.Cells(1, 1) = activation
            Else
            ActiveWorkbook.Close savechanges:=False
            End If
    Else
    
    End If
  
End Sub

So it checks the expiration date and if the password is written in a certain cell.
If it's expired and the code is not there, then the user has to enter the key.
If it's the same, the file is unlocked.
I guess this will keep the majority of my clients with a locked file.

Does anyone see any major flaws in this?

I don't mean deleting anything on the workbook, just make the code unusable, so they have to come to you for help,
ie:

Set cVB = Application.VBE.ActiveVBProject.VBComponents

    cVB.Remove VBComponent:= cVB.Item("Module1")

The basic problem, like I said, is any 'security features' in Excel can be bypassed - sometimes so easily it's laughable.

Try and open the attached 'protected.xlsm' - Excel will complain that the workbook is corrupt. It is. I changed the first byte in the file from a Hex50 to Hex60 - so the file header is invalid for an Excel workbook, so Excel complains.

The following code (which, for demo purposes, goes in another Excel workbook) will change the byte back to a H50, start another instance of Excel and load the patched file no problem.

Sub Main()

    Dim iFile As Integer
    Dim oXL As Object
    
    iFile = FreeFile
    
    If Dir(ThisWorkbook.Path & "\protected.xlsm") = vbNullString Then
        MsgBox "The application data file was not found...", vbExclamation, "Error"
        Exit Sub
    End If
    
    Open ThisWorkbook.Path & "\Protected.xlsm" For Binary Access Write As #iFile
    Put #iFile, 1, "P"
    Close #iFile
    
    ' Example only - needs to be Early Bound to trap
    ' when the user saves, quits etc
    Set oXL = CreateObject("Excel.Application")
    With oXL
        ' Just so the instance can be found later
        .Caption = "MyProtectedWB"
        .Visible = True
        
        .Workbooks.Open ThisWorkbook.Path & "\Protected.xlsm"
        
    End With

End Sub

Example only - it's doubly pointless to put code like that into an Excel workbook because of the 'security'. The reason for posting it is to illustrate a reasonably secure method to secure a workbook but that code really needs to be secure and the easiest way to do that is to get a copy of Visual Basic, either Classic VB6 or the newer VB NET. VB6 would be my choice (after using all versions of Visual Basic for nearly 20 years plus there's no external dependancies these days, you can just copy the EXE file without worrying about DLLs and the like). VBA is a subset of VB6 so there's a minimal learning curve (The code above can be ported to VB6 simply by changing 'ThisWorkbook' to 'App') and it can create EXE files which are more secure than any Excel method.

There is other code needed - Trap when the file is being saved and change the File Header of those saved copies, or prevent saving if not being saved to the same directory as the Bootstrap program, and so on as far as you want to take it.

It may seem like a lot of work but I cobbled this together in 5 minutes, it'd take about an hour to really tie this up tightly or at least tightly enough to prevent anyone but a reasonably skilled programmer to work around.

One way is to use the following code for Workbook Open Event.
The attached workbook contains a Sheet named Activation where A1 contains the Activation Key ("abab") for an example.
If the user provides this Activation Key, user won't get any prompt for trial period.
In the code the expiry date is set to "4/24/2016" so the user will have his/her last attempt to input an Activation Key on "4/24/2016" and after that date user won't be able to open the workbook.

Const exDate As String = "4/24/2016"
Private Sub Workbook_Open()
Dim akey
Dim vUser As String

'Disable the Ctrl+Break
Application.EnableCancelKey = xlDisabled

'Make sure that only one user can use this workbook
'In this case if the user is sktneer, workbook will be opened else application will be closed immediately
If Environ("UserName") <> "sktneer" Then Application.Quit

'Checking if the B1 on Activation Sheet contains the activation key which already exists in A1 on this sheet
'And if the Activation key isn't found in B1 or it is not equal to the Activation key in A1, the code will ask to input the Activation key
If Sheets("Activation").Range("B1").Value <> Sheets("Activation").Range("A1").Value Then
   
   'if today's date is after the expiry date, the application will quit
   If Date > CDate(exDate) Then Application.Quit
   
   'User will be informed that how many days are left in trial period
   MsgBox CDate(exDate) - Date & " day(s) is/are left in 30 day's trial period.", vbExclamation, "Day's Left!"
   
   'Prompt to input the Activation key
   akey = InputBox("Please input the Activation Key if you have one or click Cancel to continue.", "Activation Key Required!")
   Sheets("Activation").Range("B1").Value = akey
   
   'Now the code checks whether the Activation key provided is equal to pre-existing Activation key in cell A1 on Activation Sheet
   If Sheets("Activation").Range("A1").Value = akey Then Exit Sub
         
   'And if the today's date is greater than the date, application will quit after prompting the user.
   If Date = CDate(exDate) Then
      MsgBox "Your trial period is over.", vbCritical, "Thanks for using the Program!"
      ThisWorkbook.Save
      Application.Quit
   End If
End If
End Sub

See if this is something you can work with.

Originally Posted by sktneer

One way is to use the following code for Workbook Open Event.
The attached workbook contains a Sheet named Activation where A1 contains the Activation Key ("abab") for an example.
If the user provides this Activation Key, user won't get any prompt for trial period.
In the code the expiry date is set to "4/24/2016" so the user will have his/her last attempt to input an Activation Key on "4/24/2016" and after that date user won't be able to open the workbook.

See if this is something you can work with.

Problem is , that VBA passwords are very easy to bypass.