VBA time trial

[Gregm66]

Hi everyone,

i have found some vba on the net that creates a time trial for workbook, it is also ment to create a logfile. But it is not creating the log file for some reason,
if any one can have a look over the code and possible help correct this problem i would be appreciative.

and if possible once the time period has expired show a form with a label showing a given number specified by me, and have a text box that allows the user to insert another number (Serial Number) given by be to overide the trial period and allow access to the workbook..

not sure if this is easy enough or can be done.

Thanks all in advance..

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 / 144   '< 10 mins 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 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
            Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , StartTime
      Else
            Open ObscurePath & ObscureFile For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
            Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , StartTime
            CurrentTime = Format(Now, "#0.#########0")
            If CurrentTime < StartTime + TrialPeriod Then
                  Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
                  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 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
                        SaveShtsAsBook
                        [A1] = "Expired"
                        ActiveWorkbook.Save
                        Application.Quit
                  ElseIf [A1] = "Expired" Then
                        Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
                        Application.Quit
                  End If
            End If
      End If
      Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
End Sub

Second code that is ment to run

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
                              .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 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
            Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , "Thank you for trying out this product."
            Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , "If it meets your requirements, visit"
            Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , "http://www.xxxxx/xxxx to purchase"
            Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , "the full (unrestricted) version..."
            Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
End Sub

 

[Gregm66]

Thankyou to everyone that has looked at my question.

I managed to solve this one with some code changes... Using macros and a userform..

Thankuou all

 

[Logit]

.
Please post the solution code for others to learn and benefit.