Setting a Trial Period / Timer for Software

Hi everyone,

My company has developed an estimating software based in Excel with VB.  They are interested in rolling out the software, but want to put some restrictions on it.  Right now I'm using the following code to make the software run on a 30-day trial.  The code defnitely works, but is easily worked around if the user ever finds the log file.  Also, the security differences between XP and Vista pose a problem for the 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


So my question is, what else can I do to put a timer on the software?  I know I'm pretty limited on what I can do since I'm working with Excel, but there has to be a better way.  Any advice / suggestions on this matter are greatly appreciated.

ThanksStart Free Trial