Click here to Skip to main content
15,072,422 members
Please Sign up or sign in to vote.
0.00/5 (No votes)
i Have To editing in this code below For Then The Trial Period Expired My Workbook gos Very Hidden ...
I need to set very hidden Cammad Also Repley

Option Explicit
Private Sub Workbook_Open()
      Dim StartTime#, CurrentTime#
      'Integers (1, 2, 3,...etc) = number of days use
      '1/24 = 1Hr, 1/48 = 30Mins, 1/144 = 10Mins use
      Const TrialPeriod# = 0     '< 10000 day trial
      'set your own obscure path and file-name
      Const ObscurePath$ = "C:\"
      Const ObscureFile$ = "aamir.Log"
      If Dir(ObscurePath & ObscureFile) = Empty Then
            StartTime = Format(Now, "#0.#########0")
            Open ObscurePath & ObscureFile For Output As #1
            Print #1, StartTime
            Open ObscurePath & ObscureFile For Input As #1
            Input #1, StartTime
            CurrentTime = Format(Now, "#0.#########0")
            If CurrentTime < StartTime + TrialPeriod Then
                  Close #1
                  Exit Sub
                  If [A1] <> "Expired" Then
                        MsgBox "Sorry, your trial period has expired - your data" & vbLf & _
                        " for your..." & vbLf & _
                        "" & vbLf & _
                        "This workbook will then be made unusable."
                        Close #1
                        [A1] = "Expired"
                  ElseIf [A1] = "Expired" Then
          Worksheets("Sheet1").Visible = xlSheetVeryHidden
                        Close #1
                  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
             .Close SaveChanges:=True
                  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, " to Resloved"
            Print #1, "the full (unrestricted) version..."
            Close #1
End Sub
Updated 7-Apr-11 20:41pm
Wendelius 8-Apr-11 2:41am
pre tags added
Maciej Los 9-Apr-11 7:36am
I can't understand why are you save some data into log file. Can't you use DocumentProperty or windows registry to save expired date? It's simplest. Which version of Excel? Is it Excel Addin?

1 solution

If file isn't Excel AddIn, execution of code depends on "Enable macros" option and macros level.
So, the code will never execute, if macro level is set to "high" or user choose "Disable macro" button.

Option Explicit

Sub TestExpDate()

Dim retVal As Variant
retVal = GetExpiredDate()
'0 => not set
If retVal = 0 Then retVal = SetExpiredDate()
If retVal > Date Then
    MsgBox DateDiff("d", Date, retVal) & " days left!", vbInformation, "Information..."
    MsgBox "The end!", vbInformation, "Information..."
End If

End Sub

'set value to custom document property
'it's visible in Excel File->Properties menu or file properties (Explorer window)
Function SetExpiredDate() As Variant
Dim retVal As Variant, dp As DocumentProperty, dDate As Date

On Error GoTo Err_SetExpiredDate

'default value: 0 => can't set
retVal = 0
dDate = DateAdd("d", 30, Date)
Set dp = ThisWorkbook.CustomDocumentProperties.Add(Name:="ExpDate", LinkToContent:=False, Type:=msoPropertyTypeDate, Value:=dDate, LinkSource:=False)
retVal = dp.Value

    On Error Resume Next
    Set dp = Nothing
    SetExpiredDate = retVal
    Exit Function
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SetExpiredDate
End Function

'get value from custom document property
Function GetExpiredDate() As Variant
Dim retVal As Variant, dp As DocumentProperty

On Error GoTo Err_GetExpiredDate

'default value: 0 => not set
retVal = 0

'if exists "ExpDate", get value from custom document property
'if not exists, goto error handler to catch error
Set dp = ThisWorkbook.CustomDocumentProperties("ExpDate")
retVal = dp.Value

    On Error Resume Next
    Set dp = Nothing
    GetExpiredDate = retVal
    Exit Function
    Select Case Err.Number
        Case 9, 5
            retVal = 0
        Case Else
            MsgBox Err.Description, vbExclamation, Err.Number
    End Select
    Resume Exit_GetExpiredDate
End Function

'deletes custom document property
Sub DeleteExpDate()
On Error Resume Next
End Sub

You can use some trick:
1) hide your "working" sheet,
2) add empty sheet and place information: "To use this file, you must enable macros.",
3) add code to make your sheet visible everytime when user open file until date is < exp. date.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900