Setting a Trial Period in Excel

K0st4din

Active Member
Joined
Feb 8, 2012
Messages
385
Office Version
  1. 2013
  2. 2011
  3. 2010
  4. 2007
Platform
  1. Windows
Hello to all the Gods in this forum.
After a lot of searching on the internet, I was able to find what I needed.
But, somehow I can't understand this macro 100%.
To make it easier, I will attach a link to the page where various options and changes in the macro itself are commented, while in the last comment a final and a macro are given, which is set up properly.
I also downloaded the file, entered the macros and opened this LOG file.
The person who did it in the macro describes some numbers, and in the hidden LOG file gives others.
I don't understand these trial days, where they are written in the log file or in the macro itself?
I also can't understand, these words at the beginning and at the end - should they always be contained and numbers should be inserted between them?
In the description in the macro he gave examples, which number is equal to what, but the actually ready code (for continuation of the workbook or a new trial period) in the code - no number matches.
I am asking you for some clarification, I am only begging for that.
I am also posting the last code I am talking about and the link to the official page.
Thank you all for your cooperation.
Setting a Trial Period / Timer for Software Solutions | Experts Exchange


VBA Code:
Private Sub Workbook_Open()
    Dim StartTime#, CurrentTime#
    Dim TrialPeriod, NewStartTime, NewTrialPeriod
    Dim ContKey As String
    Dim sh As Worksheet
    
    Dim rStartTime As Range
    Dim rTrialPeriod As Range
    Dim rKeyList As Range
    
    
    
'********ADDED*********
'    Dim UsedKey As String
    Dim KeyList As String
    Dim KeyOk As Boolean
    KeyOk = True
'*********************

Set sh = Sheets("Log") 'This sheet is very hidden
    Set rStartTime = sh.Range("StartTime") '(Range A2 of Log sheet)
    Set rTrialPeriod = sh.Range("TrialPeriod") '(Range B2 of Log sheet)
    Set rKeyList = sh.Range("KeyList") '(Range C2 of Log sheet)
    
     '*****************************************
     '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

    TrialPeriod = 15 '< 15 days trial


    'If no start time exists then enter the start time and
    'the trial period set above into hidden sheet and exit sub
    If rStartTime.Value = "" Then
        rStartTime.Value = Format(Now, "#0.#########0")
        rTrialPeriod = TrialPeriod
        MsgBox "Thank you for trying this software"
        ThisWorkbook.Save
        Exit Sub
    Else 'If start time does exist, get the start time and the trial period from the hidden sheet
        StartTime = rStartTime.Value
        TrialPeriod = rTrialPeriod.Value
        
    End If

        CurrentTime = Format(Now, "#0.#########0")

        'If not past trial perid then exit sub
        If CurrentTime < StartTime + TrialPeriod Then
            Exit Sub
        End If

        'If A1 <> Expired
         If [A1] <> "Expired" Then
                'Input box for option of entering a key
                ContKey = InputBox("Sorry, your trial period has expired.  If you " & _
                 "have a key, enter it now, otherwise your data will be extracted and " & _
                 "saved for you..." & vbNewLine & "This workbook will then be made unusable until you purchase a key.")

                'Check list of already used keys to see if key has been used before.  If it has then set
                'KeyOk to False (it's set to true at the beginning of this sub
                Do Until rKeyList.Value = ""
                    If rKeyList.Value = ContKey Then KeyOk = False
                    Set rKeyList = rKeyList.Offset(1, 0)
                Loop
                Set rKeyList = sh.Range("KeyList")
                
               If KeyOk = False Then
                    MsgBox "Sorry, that is not a valid key.  You can try again after you purchase a key"
'                    SaveShtsAsBook
                    [A1] = "Expired"
                    ActiveWorkbook.Save
                    Application.Quit
                    Exit Sub
               End If
'*******************************



                'If the key entered into input box does not match a pattern you pick then
                'run SaveShtsAsBook and do whatever else you need to do to end your app
                'The pattern in this code is the first 5 characters must be
                '"w14rt" and the last 7 must be "trbft51" in upper or lower case
                If UCase(Left(ContKey, 5)) <> "W14RT" Or UCase(Right(ContKey, 7)) <> "TRBFT51" Then
                    MsgBox "Sorry, that is not a valid key.  You can try again after you purchase a key"
'                    SaveShtsAsBook
                    [A1] = "Expired"
                    ActiveWorkbook.Save
                    Application.Quit
                    Exit Sub
                 Else
                    'Else if the pattern of the key is ok then retrieve the the data from the middle of the key
                    'which will be some kind of hidden message to tell how much longer to continue
                    'the trial.  Then open the log file back up and enter the new data
                    'I will use characters 6, 8, 9, 12, 13, 15, and 17 as the digits to retrieve
                    'for the trial period (the reason for so many is in case you have a lifetime
                    'key to give, just make the number really huge so it's like millions of days
                    'into the future, otherwise use leading zeros for the first however many digits
                    'you need to.  You will pick what to put into those places when for the key that
                    'gets entered, and that will decide the new trial period. So those characters places
                    'that I mentioned above will be where you want to have digits that will decide the new
                    'trial period in the key that you give them.  Nobody will know the pattern, or the
                    'place of the characters to retrieve
                    NewStartTime = Format(Now, "#0.#########0")

                    'Make NewTrialPeriod = to the number of days for the extended period
                    NewTrialPeriod = Val(Mid(ContKey, 6, 1) & Mid(ContKey, 8, 1) & Mid(ContKey, 9, 1) & _
                     Mid(ContKey, 12, 1) & Mid(ContKey, 13, 1) & Mid(ContKey, 15, 1) & Mid(ContKey, 17, 1))

                    'Enter the new start time and trial period, then exit sub
                    rStartTime.Value = NewStartTime
                    rTrialPeriod.Value = NewTrialPeriod
                    
                    'Add this key to the list of keys already used
                    sh.Range("C" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Value = ContKey
                    [A1].Value = ""
                    ThisWorkbook.Save
                    Exit Sub
                End If
            End If

            'If A1 already = "Expired" still offer a chance to enter a key which is almost a duplicate of
            'above but with a different message and just quit application if no valid key is entered
            If [A1] = "Expired" Then
                ContKey = InputBox("Sorry, your trial period has expired.  If you " & _
                 "have a key, enter it now, otherwise this application will end.")


                'Check list of already used keys to see if key has been used before.  If it has then set
                'KeyOk to False (it's set to true at the beginning of this sub
                Do Until rKeyList.Value = ""
                    If rKeyList.Value = ContKey Then KeyOk = False
                    Set rKeyList = rKeyList.Offset(1, 0)
                Loop
                Set rKeyList = sh.Range("KeyList")

               If KeyOk = False Then
                    MsgBox "Sorry, that is not a valid key.  You can try again after you purchase a key"
                    Application.Quit
                    Exit Sub
               End If


                'If the key pattern is not ok then just bring up message and quit
                If UCase(Left(ContKey, 5)) <> "W14RT" Or UCase(Right(ContKey, 7)) <> "TRBFT51" Then
                    MsgBox "Sorry, that is not a valid key.  You can try again after you purchase a key"
                    Application.Quit
                    Exit Sub
                Else
                    'key pattern was ok so get the characters just like from above
                    'and change the start time and trial period on the hidden sheet
                     NewStartTime = Format(Now, "#0.#########0")

                    'Make NewTrialPeriod = to the number of days for the extended period
                    NewTrialPeriod = Val(Mid(ContKey, 6, 1) & Mid(ContKey, 8, 1) & Mid(ContKey, 9, 1) & _
                     Mid(ContKey, 12, 1) & Mid(ContKey, 13, 1) & Mid(ContKey, 15, 1) & Mid(ContKey, 17, 1))

                    'Enter the new start time and trial period into the log file, then exit sub
                    rStartTime = NewStartTime
                    rTrialPeriod = NewTrialPeriod

                    'Add this key to the list of keys already used
                    sh.Range("C" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Value = ContKey
                    [A1].Value = ""
                    ThisWorkbook.Save
                    Exit Sub
                End If
            End If
'Now at this point if a valid key is entered, then the trial period should be extended whatever
'lenght of time was decided from the digits that I mentioned above...
'so for example...if you were to send someone a key to extend the period 30 days, it would be a key
'something like this: W14RT0M00BH007390TRBFT51
'First 5 have to be w14rt, and last 7 have to be trbft51 (in upper or lower case, doesn't matter) to
'match the pattern for a key you would give someone
'The code retrieves digits 6, 8, 9, 12, 13, 15 and 17 to get the trial extension time
'6, 8, 9, 12, and 13 are zeros, 15 is a 3, and 17 is a zero to end up with 0000030

End Sub
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,959
This would be a tedious method on your side but ...

You could have 12 different passwords. One password for each month of the year. When the Jan password expired, you could just email them the Feb password. When the Feb password expired, you
could email them the March password, etc. etc.

The other method (and not as tedious) is to send them a completely new workbook with a single new password as you've already described.

Here is a simple macro (paste in ThisWorkBook module) that will do that job for you. Study the code so you understand where to change the expiration date
and the password. The password to this example is pwd.

VBA Code:
Option Explicit

Public MyDate As Variant
Public Passwd As String

Private Sub WorkBook_Open()
Dim mbox As String

MyDate = #5/29/2020#    ' Change this date as required. Leave the pound symbols as is.
Passwd = "pwd"         'Assign password

Application.ScreenUpdating = False
Sheets("Sheet1").Visible = True
Application.ScreenUpdating = True

    If Date > MyDate Then
        MsgBox "Oops! Test/Evaluation period of the utility has been expired." & vbCrLf & vbCrLf & _
        "Pls ask the appropriate authority to supply the updated utility.", vbCritical, "Outdated/Expired Version"
       GoTo done:
    End If
    
    mbox = InputBox("Please enter password. ", "Password Required")
    If mbox = Passwd Then GoTo cont:
    
    If mbox <> Passwd Then
        MsgBox "Incorrect Password" & vbCrLf & vbCrLf & _
        "Pls ask the appropriate authority to supply the correct password.", vbCritical, "Wrong password"
        Application.Quit
    End If

cont:
Exit Sub

done:
Application.Quit

End Sub
 

Some videos you may like

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,959
Disregard hiding Sheet2. That line of code was left over from a previous project.
 

K0st4din

Active Member
Joined
Feb 8, 2012
Messages
385
Office Version
  1. 2013
  2. 2011
  3. 2010
  4. 2007
Platform
  1. Windows
As I look, it would be best to send them a new file each time.
I have reviewed your proposal:
MyDate = # 5/31/2020 #
Passwd = "pwd" - this is the password for the month of May
Let's play this hypothetical file.
Tomorrow is June 1 - the above date and password are for May and are in the file that is with them and this date and password are in the locked macros.
Hypothetically, to open the file in June, you just say send them an email with the new password. Let's say it's "food06" and the date will have to be # 6/30/2020 #.
So, how do these values change in their file, as only I have authority over the whole file and especially the macros?
Maybe here we are approaching the same ambiguity that I had with this macro that I found ?! :unsure: :eek: :)
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,959
Before we discuss your proposal of sending them a new password and expiration date ... the primary question is "WHY ?"

You've already stated you could send them a brand new workbook. Why are you interested in complicating your process that could be
fraught with errors ?
 

K0st4din

Active Member
Joined
Feb 8, 2012
Messages
385
Office Version
  1. 2013
  2. 2011
  3. 2010
  4. 2007
Platform
  1. Windows

ADVERTISEMENT

My idea was this: I send them the file once. For example, they have the option to fill in data for one month.
When the month is over, each user will see a message that he can no longer use the file and will have to send it to me. Then, I send each user a new password, when he opens the workbook and enters the new password, the Excel workbook starts counting down new days set by me. And so on in time ahead.
You may be right that I will embark on great adventures with these passwords. Before taking any action, I will try both of your proposed macros. The first, when the specified date has passed and is locked and the one above (the second) whether to write each time the user opens the file.
I understood very well that in the first hide Sheet2, which has nothing to do with the second macro. Still, if I decide on the first option, do I need this second worksheet at all and what do we hide in it?
And last but not least, I reaffirm that you are unique, both as a site and as people. You have always helped people, you have always shown understanding, and very often you give very good advice. 🙏:)
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,959
Disregard hiding Sheet 2 altogether no matter what route you take. Hiding the sheet is not necessary and performs no function at all in these scenarios.

"When the month is over, each user will see a message that he can no longer use the file and will have to send it to me. Then, I send each user a new password, when he opens the workbook and enters the new password, the Excel workbook starts counting down new days set by me. And so on in time ahead. "

Re: The above .. the only way you can do that (reasonably), is to have the workbook "programmed" with the passwords for all 12 months of the year. Your code must already have the necessary
passwords for the coming months. Perhaps after a year ... you send them a brand new workbook with another set of 12 passwords. A method that would be easiest for you ... send a new workbook
each month with a new password. It simplifies your coding in that you don't have to create a macro that considers twelve different passwords and twelve different termination dates.

Sending a new workbook each month only requires you to create a new password. The workbook design and structure remains the same all the while ... you are only changing the expiration date and the
new password.
 

K0st4din

Active Member
Joined
Feb 8, 2012
Messages
385
Office Version
  1. 2013
  2. 2011
  3. 2010
  4. 2007
Platform
  1. Windows
Hello @Logit ,
this will remain as a last resort. After much thought, I became convinced (mostly of your help) that this was the right way. I will send them a new file every month, with a new password.
Final
Thank you very much.
Be alive and healthy and still dedicated to everyone.
How can I give you 1,000,000 stars? :) 🤩🤩🤩
 

Watch MrExcel Video

Forum statistics

Threads
1,127,479
Messages
5,625,005
Members
416,065
Latest member
meiravmeron

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
Top