Set a Trial Period For Use of Your Project

[Taislin]

Hi again... i've been looking around in google so i can define a way to get a trial period and came acrosse with this code:

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

This code does exactly what i want and i really want it to create a log file or any other type of file that records the date for expiracy purposes. The problem is when i open the workbook with this macro on it shows this error: Runtime Error '75': Path/File acess error.

Don't know what is wrong. I've tried to change the Log file to TestFileLog.txt and nothing, same error again on openning.
When i debbug it a yellow line appears over this: "Open ObscurePath & ObscureFile For Output As #1"

[Taislin]

Anybody can help on this error please?

[Taislin]

I've found that if i erase the directory "C:\" and let the code as Const ObscurePath$ = ""
Const ObscureFile$ = "TestFileLog.Log" it now creates the TestfileLog file but this file goes to My Documents automaticlly. I would like to put it somewhere in windows folder so it can be "hidden" from users. In My Documents is to visible. Just don't know how to make the path cause everytime i use "C:\Windows\" it gives the same error 75. Guess cannot write on C:\ but i'm the admin of the computer and i'm logged as admin besides i can create o My Documents which is located in C:\, so i dont understand why i cant direct to create the file where i want! I'm using Excel 2007

[mrice]

You could try changing the default folder just before your file opening.

ChDir(ObscurePath$)
Open ObscureFile$ For Output As #1

[Taislin]

Change the default folder? But the this file is suposed to open by any person in any computer. So i cant instruct every person that downloads the file to change directories because they will know where the log file is hidden. Dont really know what you mean by that sollution sorry. And where do i put that code in the one i already have? Here is a file with the code i have so you can check it out. Thank you for your reply and your help.

[mrice]

I was thinking something like this.

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# = 1     '< 1 day trial

      'set your own obscure path and file-name
      Const ObscurePath$ = "C:\"
      Const ObscureFile$ = "TestFileLog.Log"
      '*****************************************
      ChDir (ObscurePath$)
      If Dir(ObscurePath & ObscureFile) = Empty Then
            StartTime = Format(Now, "#0.#########0")
            Open ObscureFile For Output As #1
            Print #1, StartTime
      Else
            Open 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
      ChDir ("C:\")
End Sub

[Taislin]

@mrice,

I tried but then got this error... see in attached image.

Moderator's Note: As per Forum Rule #12, don't quote whole posts unless necessary-- it's just clutter...Thanks.

[event21]

Hi -

Use registry, much better approach

Private Const mc_APPNAME = "Project Expiration"
Private Const mc_APPSECTION = "Usage"
Private Const mc_APPKEY = "Expiry"
Private Sub Workbook_Open()
Dim vntRegItem As Variant
    vntRegItem = GetSetting(Appname:=mc_APPNAME, _
    Section:=mc_APPSECTION, _
    Key:=mc_APPKEY, _
    Default:="")
    If vntRegItem = "" Then
         ' no information stored yet so do now
        vntRegItem = Format(Now() + 7, "dd-mmm-yyyy")  ' 7 days from now
        SaveSetting Appname:=mc_APPNAME, _
        Section:=mc_APPSECTION, _
        Key:=mc_APPKEY, _
        Setting:=vntRegItem
         
    Else
         ' have information stored so test it
        If Now() > CDate(vntRegItem) Then
             MsgBox "This file has expired", vbCritical Or vbOKOnly, "File Expired"
             thisworkbook.close false
            End
        Else
            MsgBox "This file has " & CLng(CDate(vntRegItem) - Now) + 1 & " days left", _
            vbExclamation Or vbOKOnly, "File Expiry Warning"
        End If
    End If
End Sub

Regards,
Event

[Taislin]

@event21,

Gonna try it. Thank you.

Moderator's Note: As per Forum Rule #12, don't quote whole posts unless necessary-- it's just clutter...Thanks.

[Taislin]

@event21,
Works like a charm... only one question though... The macro that i opened the topic was chosen because when the Log file was created and the file expires, then i knew where to find the file and delete it if i want the file to open again (without disabling macros on excel). But in Registry where this macro you provided creates the KEY so i can delete it if need too?

Moderator's Note: As per Forum Rule #12, don't quote whole posts unless necessary-- it's just clutter...Thanks.

[event21]

Hi -

it is in
HKEY_CURRENT_USER\Software\VB and VBA Program Settings

Regards,
Event

[Taislin]

Found it to by using Search function Thank you very much. Really liked this approach. You solved my day. ;D

Moderator's Note: As per Forum Rule #12, don't quote whole posts unless necessary-- it's just clutter...Thanks.

[Taislin]

Only now i see the Moderator's Note. Sorry for quote a lot. Didn't knew it us against the forum rules. At the time of the replies the moderators notes were not visible thats why i kept quoting. Never happen again. Sorry.

Regards, Mário

[ras2021]

There is one problem in this macro code, when system date is set to the earlier date it starts working, I just want if it is for 7 days from now. It work for only 7 days when system date is reset then file should close automatically. Can anyone help me for this?

[JosephP]

Welcome to the Forum.

Unfortunately your post does not comply with Rule 2 of our Forum RULES. Do not post a question in the thread of another member -- start your own thread.

If you feel an existing thread is particularly relevant to your need, provide a link to the other thread in your new thread.

Old threads are often only monitored by the original participants. New threads not only open you up to all possible participants again, they typically get faster response, too.