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#
      '*****************************************
      '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# = 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
      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 & _
                        " www.xxxxxxx.com for your..." & vbLf & _
                        "" & vbLf & _
                        "This workbook will then be made unusable."
                        Close #1
                        SaveShtsAsBook
                        [A1] = "Expired"
                        ActiveWorkbook.Save
                        Application.Quit
                  ElseIf [A1] = "Expired" Then
          Worksheets("Sheet1").Visible = xlSheetVeryHidden
                        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
             .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, "http://www.xxxxxxxxx.net.tc to Resloved"
            Print #1, "the full (unrestricted) version..."
            Close #1
End Sub
Posted
Updated 7-Apr-11 20:41pm
v2
Comments
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.

VB
Option Explicit

Sub TestExpDate()

Dim retVal As Variant
retVal = GetExpiredDate()
'0 => not set
If retVal = 0 Then retVal = SetExpiredDate()
'date
If retVal > Date Then
    MsgBox DateDiff("d", Date, retVal) & " days left!", vbInformation, "Information..."
Else
    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)
DeleteExpDate
Set dp = ThisWorkbook.CustomDocumentProperties.Add(Name:="ExpDate", LinkToContent:=False, Type:=msoPropertyTypeDate, Value:=dDate, LinkSource:=False)
retVal = dp.Value

Exit_SetExpiredDate:
    On Error Resume Next
    Set dp = Nothing
    SetExpiredDate = retVal
    Exit Function
    
Err_SetExpiredDate:
    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

Exit_GetExpiredDate:
    On Error Resume Next
    Set dp = Nothing
    GetExpiredDate = retVal
    Exit Function
    
Err_GetExpiredDate:
    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
ThisWorkbook.CustomDocumentProperties("ExpDate").Delete
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