Setting a Trial Period in Excel

[K0st4din]

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

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]

.
Wow ! That is A TON OF CODE for just time limiting a workbook !

Here are two other methods that are easier than the above macro. The first is more involved (but still tons easier than the above macro). The second
example is short and to the point.

Option Explicit

Public MyDate As Variant
Public Passwd As String

Private Sub WorkBook_Open()
Dim mbox As String

MyDate = #8/28/2019#  ' Assign a date.
Passwd = "ABCD" 'Assign password

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

If Date > MyDate Then
MsgBox "Oops! Test/Evaluation period of the utility has been expired." & vbCrLf & _
  "Pls ask the concern person to get the updated utility.", vbCritical, "Outdated/Expired Version"
  mbox = Application.InputBox("Pls input the password/code to continue...", "Password")

  If mbox <> Passwd Then
  MsgBox "Incorrect Password" & vbCrLf & _
  "Pls ask the concern person to get the correct password.", vbCritical, "Wrong password"

Application.Quit
With ThisWorkbook
  .Save
  .ChangeFileAccess Mode:=xlReadOnly
  Kill .FullName
  .Close SaveChanges:=False
  End With
Else
  Sheets("Sheet2").Visible = True
  Sheets("Sheet1").Visible = False
  End If

End If

#2 :

Option Explicit

'After and on July 1 this year, the code would not run past the first line because the current date would be greater han the criteria date.

Code:
Sub t()
If Date >= #7/1/2019# Then Exit Sub
'Your regular code here
End Sub
'Date is current date
'The date with the pound symbols is the criteria date. The pound symbols make it date literal so it will be the correct data type.

 

[K0st4din]

.
Wow ! That is A TON OF CODE for just time limiting a workbook !

Here are two other methods that are easier than the above macro. The first is more involved (but still tons easier than the above macro). The second
example is short and to the point.

Option Explicit

Public MyDate As Variant
Public Passwd As String

Private Sub WorkBook_Open()
Dim mbox As String

MyDate = #8/28/2019#  ' Assign a date.
Passwd = "ABCD" 'Assign password

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

If Date > MyDate Then
MsgBox "Oops! Test/Evaluation period of the utility has been expired." & vbCrLf & _
  "Pls ask the concern person to get the updated utility.", vbCritical, "Outdated/Expired Version"
  mbox = Application.InputBox("Pls input the password/code to continue...", "Password")

  If mbox <> Passwd Then
  MsgBox "Incorrect Password" & vbCrLf & _
  "Pls ask the concern person to get the correct password.", vbCritical, "Wrong password"

Application.Quit
With ThisWorkbook
  .Save
  .ChangeFileAccess Mode:=xlReadOnly
  Kill .FullName
  .Close SaveChanges:=False
  End With
Else
  Sheets("Sheet2").Visible = True
  Sheets("Sheet1").Visible = False
  End If

End If

#2 :

Option Explicit

'After and on July 1 this year, the code would not run past the first line because the current date would be greater han the criteria date.

Code:
Sub t()
If Date >= #7/1/2019# Then Exit Sub
'Your regular code here
End Sub
'Date is current date
'The date with the pound symbols is the criteria date. The pound symbols make it date literal so it will be the correct data type.

Thank you very much for your cooperation, but again it is not clear to me, even in the one I found - how after I have already sent the excel file, to send only a new extension code (password), even in the one you send me offer (The first)?
MyDate = # 8/28/2019 # 'Assign a date. - Should I record here the date on which the trial period should end?
And where are the passwords used so far stored?
In a sense, we have worksheet 2 (Sheet 2 - which is very hidden) - ie will they be stored there? If so, after I send a new password, will it be added to the hidden Sheet 2 or will I have to send a brand new file with a new period (1 day, 1 month, 6 months, etc.) with a new password. And then, should I make the passwords written so far in another file so that they are not repeated?

 

[Logit]

.
Ok ... I understand what your goal is now.

Time limit your project as you normally would.

Personally, requiring the user to enter a password each time they want to use the project during the trial time is redundant. It is better to
display a Message Box that tells the user how many days they have left to use the workbook.

Your project should always have a means for the user to input the password that gives continual access, once they have made payment.
Have your code written so the password is already there. All you need to do is email them the password. You can design all of your workbooks
that are sold to use the same password for full access .. or ... keep track of each customer and provide each customer a different password
that provide full access.

Tracking how many times a user opens the workbook is also overkill. Just limit the project to X days of usage without payment.

You can designed your project so all of the code goes in the ThisWorkbook module ... utilizing the Workbook_Open sub. Or you can
also place a call to your time limiting macro in the Workbook_Open sub .. and place the time limiting macro in a Regular Module.

Private Sub Workbook_Open()
     'YouTimeLimitingSubNameHere
End sub

Then, in a Regular module your time limiting sub code :

Sub TimeLimit ()
     Your Time Limiting Macro Code Here
End Sub

Now ... having said all of the above ... keep in mind that EXCEL is not secure. Never has been and probably never will be. If the user has a
rudimentary understanding of VBA coding .. they will be able to break your password without paying you. There are also tons of
password breaking code on the internet that are free for anyone to download and use. Just a FYI ...

 

[K0st4din]

So, so, I very much agree with you.
To show the user that the file has expired.
I hadn't thought of that trick.
My idea is completely different from selling my works.
In the company we want to make a file to fill in data in it, but for example to give them a period of 30 days. When these 30 days expire, they may not be able to work with the file at all.
This macro I was able to find allowed me (which I never understood) to send only a new code (password).
In your help (I liked the first macro), when someone calls me that he can't open the file (this will be a hint for me that the deadline has expired) I will have to send him a new file, a new password and this file will can work based on the period set by me.
Is that how I should understand it?
And one more thing, can I put your macro in module, because in ThisWorkbook, I already have another macro that does other actions on Workbook_Open?
I searched a lot, but I couldn't find a way how to put two or three different macros in ThisWorkbook?
As for the fact that Excel is not protected, I know and understand it very well, but still, it will be sent to people who are not at all familiar with these actions.
PS - my idea is that if I give them the password, from now on, they will be able to use the file indefinitely. I don't want this, I want to control how long the file is used.

 

[Logit]

Keep in mind ... if you send them a completely new workbook with a new ending date ... what are they to do with all the data they have generated
with the previous workbook ? Do they discard it ? Are you making them copy the data from the old workbook to the new workbook ?

What is the best method for the user ?

You can place as much code as you desire in the Workbook_Open sub. However, I believe EXCEL has a limit of 64 kb of text. At some point, if you get that high,
EXCEL will start crashing because there is too much code in the sub.

 

[K0st4din]

No, no, let's say I give them 30 days. After these 30 days, they will no longer be able to open the workbook, but when they send it to me, I will have the password and will be able to open it and see the information in it. It is important for me.
When I send them a new workbook, they will start re-entering the information, with new data but within the 30 days I have allowed.
As for Workbook_Open, do you mean to make the macros in separate modules and put the titles of these same macros?
For example:
Sub Workbook_Open ........
Macro 1
Macro 2
End Sub
or just put the macros one below the other?

 

[Logit]

.
Regarding this question :

For example:
Sub Workbook_Open ........
Macro 1
Macro 2
End Sub
or just put the macros one below the other?

You can do either ... its fine. Comes down to your personal preference. For example, I don't enjoy seeing the ThisWorkBook module loaded with an over abundance of code.
So, I prefer to place a "call" (just the macro name) to the various macros. It works either way for almost every macro. However, you will find that Excel will not like certain
macros to be completely placed in the ThisWorkBook module. I can't give you an example as it has not occurred but a few times. Someone else on the Forum might be able
to explain. Just remember if you place macro code in the ThisWorkBook module and you know the code is correct .... place a "call" there and move the macro out on its own.

Also keep in mind, the more code you place in the Workbook_Open sub ... the longer it will take for the workbook to open completely.

Help me understand why you are using passwords on the workbook if your method is to send them a completely new workbook each time ? Is the password meant to prevent
anyone else but the specific user from gaining access ? If not, why use a password at all ?

 

[K0st4din]

.
Help me understand why you are using passwords on the workbook if your method is to send them a completely new workbook each time ? Is the password meant to prevent
anyone else but the specific user from gaining access ? If not, why use a password at all ?

Now, this macro that I found was made (again, I couldn't figure out how to just send a new password) without sending a new file, just a password. For this reason, I asked for help - I found it, but I could not understand it 100%.
Each user will have their own password.
After 20 days, the file with your macro will tell them that they can no longer work with this file, even if one user sends it to another user, the second will not be able to open it because the specified date has passed (according to your macro). ).
Submitting the next workbook will be necessary, because with this macro I found, we can't figure out how to send only a new password to continue filling in the table. (you were puzzled, but we still can't find the trick, how to send only a new password)?
Maybe it's something like: When the Administrator sent the file set a period, then when he sent a new password and started counting the new specified days? I don't know, the one who wrote it says that he added everything and it should work, but I don't understand it.
It's my idea that no one can read the other user's file, after the deadline (even if it's sent, after that deadline, date) they won't be able to open it, and only I will be able to open it when be sent to me.
I hope I have been able to answer.

 

[K0st4din]

P.S
Just to add a question: What do we hide in Sheet2, in your macro?