Excel

Set a Trial Period For Use of Your Project

Ease of Use

Intermediate

Version tested with

2000 

Submitted by:

johnske

Description:

On first opening the workbook a log file is created. Every time the workbook is opened after that, the date & time is checked against that in the log file. If the trial period has expired the user is given a message stating that it's expired. The users data in the workbook is then transferred to separate files with a promotional text message and the workbook rendered unusable... A further alternative is to not give the user any possibility of resuscitating the workbook. To do this you will need to insert Brettdj's code to completely delete the workbook (see http://www.vbaexpress.com/kb/getarticle.php?kb_id=540) in the appropriate place(s). I'll leave that modification up to you. :) 

Discussion:

You may have spent a lot of time developing a product for sale yet you want to allow potential customers a set time to try out your product first. This code will allow you to do that. The examples in the attachment are unlocked for you to view the code, but naturally it is assumed you will lock your project and that you will also force the user to enable macros (see here http://www.vbaexpress.com/kb/getarticle.php?kb_id=578). If the project is locked for viewing there is a fairly good degree of security provided but it must be remembered that this is not infallible, however it will stop MOST people from copying your code. Apart from altering the trial period you've set in your code, the only other way to get around this trial period is to find the log file containing the start time and delete it. (Note: if it has been deleted a new file will be generated next time the workbook is opened) if you give the log file some innocuous name and place it in some obscure part of the hard drive most people will be unable to find and delete it. {If someone is so determined to hack into your code to extend the time period and/or continually find and delete the log file, I say - good luck to them :o) } 

Code:

instructions for use

			

Option Explicit Private Sub Workbook_Open() Dim StartTime#, CurrentTime# '***************************************** 'SET YOUR OWN TRIAL PERIOD BELOW 'Integers (1, 2, 3,...etc) = number of days use '1/24 = 1Hr, 1/48 = 30Mins, 1/144 = 10Mins use Const TrialPeriod# = 30 '< 30 days trial 'set your own obscure path and file-name Const ObscurePath$ = "C:\" Const ObscureFile$ = "TestFileLog.Log" '***************************************** If Dir(ObscurePath & ObscureFile) = Empty Then StartTime = Format(Now, "#0.#########0") Open ObscurePath & ObscureFile For Output As #1 Print #1, StartTime Else Open ObscurePath & ObscureFile For Input As #1 Input #1, StartTime CurrentTime = Format(Now, "#0.#########0") If CurrentTime < StartTime + TrialPeriod Then Close #1 Exit Sub Else If [A1] <> "Expired" Then MsgBox "Sorry, your trial period has expired - your data" & vbLf & _ "will now be extracted and saved for you..." & vbLf & _ "" & vbLf & _ "This workbook will then be made unusable." Close #1 SaveShtsAsBook [A1] = "Expired" ActiveWorkbook.Save Application.Quit ElseIf [A1] = "Expired" Then Close #1 Application.Quit End If End If End If Close #1 End Sub Sub SaveShtsAsBook() Dim Sheet As Worksheet, SheetName$, MyFilePath$, N& MyFilePath$ = ActiveWorkbook.Path & "\" & _ Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) With Application .ScreenUpdating = False .DisplayAlerts = False On Error Resume Next '<< a folder exists MkDir MyFilePath '<< create a folder For N = 1 To Sheets.Count Sheets(N).Activate SheetName = ActiveSheet.Name Cells.Copy Workbooks.Add (xlWBATWorksheet) With ActiveWorkbook With .ActiveSheet .Paste '//N.B. to remove all the cell formulas, '//uncomment the 4 lines of code below... 'With Cells '.Copy '.PasteSpecial Paste:=xlPasteValues 'End With .Name = SheetName [A1].Select End With 'save book in this folder .SaveAs Filename:=MyFilePath _ & "\" & SheetName & ".xls" .Close SaveChanges:=True End With .CutCopyMode = False Next End With Open MyFilePath & "\READ ME.log" For Output As #1 Print #1, "Thank you for trying out this product." Print #1, "If it meets your requirements, visit" Print #1, "http://www.xxxxx/xxxx to purchase" Print #1, "the full (unrestricted) version..." Close #1 End Sub

How to use:

  1. Open an Excel workbook
  2. Select Tools/Macro/Visual Basic Editor
  3. In the VBE window, select Tools/Project Explorer
  4. Select the ThisWorkbook module
  5. Copy and paste the code into the Module
  6. Now select File/Close and Return To Microsoft Excel
  7. Save your changes and close the workbook...
 

Test the code:

  1. In the folder in the attachment there are examples for trial periods of:
  2. 10 minutes, 1 hour, 1 day, 30 days, and 1 year.
  3. Extract these files and COPY the 10 minute example to the desktop.
  4. Open this example then have a look in the hard-drive for the file 'TestFileLog'
  5. Close and open this example a few times to ensure that it's usable then wait 10 or more minutes...
  6. Open the file again and you will be shown a message box saying your trial period has expired.
  7. On clicking OK on the message box, the workbook will close a few seconds later.
  8. If you now try to open this workbook it will instantly close.
  9. Now create another copy of the 10 minute example on the desktop and try to use it...
  10. (To use another copy you must find and delete the existing 'TestFileLog' before you can use it)
  11. Now try the other versions (naturally you will have to wait longer to test them fully)
 

Sample File:

Restrict Use.zip 74.56KB 

Approved by mdmackillop


This entry has been viewed 3529 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express