Re: Expiry of Excel shee

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance

Thanks ryguy7272 and Pecoflyer

After Click on Link which is give by both of you I got This

I am totally Stupid in VBA or Marco

How can i use this.

Option Explicit


Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 30

Sub TimeBombWithDefinedName()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TimeBombWithDefinedName
' This procedure uses a defined name to store this workbook's
' expiration date. If the expiration date has passed, a
' MsgBox is displayed and this workbook is closed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ExpirationDate As String
Dim NameExists As Boolean

On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number <> 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
'''''''''''''''''''''''''''''''''''''''''''
NameExists = False
ExpirationDate = CStr(DateSerial(Year(Now), _
Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersTo:=Format(ExpirationDate, "short date"), _
Visible:=False
Else
NameExists = True
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If the today is past the expiration date, close the
' workbook. If the defined name didn't exist, we need
' to Save the workbook to save the newly created name.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
If CDate(Now) > CDate(ExpirationDate) Then
MsgBox "This workbook trial period has expired.", vbOKOnly
ThisWorkbook.Close savechanges:=False
End If

End Sub

Sub TimeBombMakeReadOnly()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TimeBombMakeReadOnly
' This procedure uses a defined name to store the expiration
' date and if the workbook has expired, makes the workbook
' read-only.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim ExpirationDate As String
Dim NameExists As Boolean

On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number <> 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
'''''''''''''''''''''''''''''''''''''''''''
ExpirationDate = CStr(DateSerial(Year(Now), _
Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersTo:=Format(ExpirationDate, "short date"), _
Visible:=False
NameExists = False
Else
NameExists = True
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If the today is past the expiration date, make the
' workbook read only. We need to Save the workbook
' to keep the newly created name intact.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
If CDate(Now) >= CDate(ExpirationDate) Then
If NameExists = False Then
ThisWorkbook.Save
End If
ThisWorkbook.ChangeFileAccess xlReadOnly
End If

End Sub

Sub TimeBombWithRegistry()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TimeBombWithRegistry
' This procedure stores the expiration date in the system
' registry. Change C_REG_KEY to a registry key name that
' is used by your application.
'
' This procedure requires either the modRegistry module from
' www.cpearson.com/Excel/Registry.htm or
' www.cpearson.com/Excel/Registry.aspx
' or the RegistryWorx DLL from
' www.cpearson.com/Excel/RegistryWorx.aspx.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Const C_REG_KEY = "Software\Pearson\Test\Settings"
Dim KeyExists As Boolean
Dim ValueExists As Boolean
Dim ExpirationDate As Long
Dim B As Boolean
KeyExists = RegistryKeyExists(HKEY_CURRENT_USER, C_REG_KEY, False)
If KeyExists = True Then
'''''''''''''''''''''''''''''''''
' Key exists. Get the Value from
' the key.
'''''''''''''''''''''''''''''''''
ValueExists = RegistryValueExists(HKEY_CURRENT_USER, C_REG_KEY,
"Expiration")
If ValueExists = True Then
'''''''''''''''''''''''''''''''''''''''''
' Value exists. It will be the
' expiration date.
'''''''''''''''''''''''''''''''''''''''''
ExpirationDate = RegistryGetValue(HKEY_CURRENT_USER, C_REG_KEY,
"Expiration")
Else
'''''''''''''''''''''''''''''''''''''''''
' Value doesn't exist. Set the expiration
' date and update the Registry.
'''''''''''''''''''''''''''''''''''''''''
ExpirationDate = DateSerial(Year(Now), Month(Now), _
Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION)
B = RegistryCreateValue(HKEY_CURRENT_USER, C_REG_KEY, "Expiration",
CLng(ExpirationDate))
If B = False Then
' error creating registry value
End If
End If
Else
''''''''''''''''''''''''''''''''''''''''
' Key doesn't exist. Set the expiration
' date and create the Key and Value.
''''''''''''''''''''''''''''''''''''''''
ExpirationDate = DateSerial(Year(Now), Month(Now), _
Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION)
B = RegistryCreateKey(HKEY_CURRENT_USER, C_REG_KEY)
If B = True Then
B = RegistryCreateValue(HKEY_CURRENT_USER, C_REG_KEY, "Expiration",
ExpirationDate)
If B = False Then
' error creating registry value
End If
Else
' error creating registry key
End If
End If
'''''''''''''''''''''''''''''''''''''''''''
' If Now is past the expiration date,
' close the workbook.
'''''''''''''''''''''''''''''''''''''''''''
If CLng(Now) > CLng(ExpirationDate) Then
ThisWorkbook.Close savechanges:=False
End If

End Sub


Actually i want to Nobody can See the file after 10 minute or after 1 hour

Thanks in Advance

Hardeep kanwar

"Pecoflyer" wrote:


Hi,

you can find examples and considerations on time-bombing XL sheets at
'Timebombing A Workbook'
(http://www.cpearson.com/excel/workbooktimebomb.aspx)
Be aware that there is no fool-proof method of doing this.

HTH

Hardeep kanwar;288365 Wrote:
Hi! Everyone

I don't Know Whether my Question have a Sense or not.

But it is Possible to Expire Excel Sheet on Specific Time or Date.


And Even if I Mail that sheet to any Person and he Open After the
Expiry
Time or Date

I want to Show the Message "Unable to Open"


Protected Sheet is not a good Option These Password can be Break
Easily


Any Help Would be Most Appreciate

Hardeep kanwar


--
Pecoflyer

Cheers -
*'Membership is free' (http://www.thecodecage.com)* & allows file
upload ->faster and better answers

*Adding your XL version* to your post helps finding solution faster
------------------------------------------------------------------------
Pecoflyer's Profile: http://www.thecodecage.com/forumz/member.php?userid=14
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=80570


.

Relevant Pages

  • Re: How to time-limit an Excel file installation
    ... In my file, I've called the main macro TB, and the foo macro TB_see ... I create a new workbook, paste the TB macro code into a general module exactly ... 'Private Sub Workbook_Open ... ' expiration date. ...
    (microsoft.public.excel.worksheet.functions)
  • Re: Expiry of Excel shee
    ... ' expiration date. ... ' MsgBox is displayed and this workbook is closed. ... Dim ExpirationDate As String ... Change C_REG_KEY to a registry key name that ...
    (microsoft.public.excel.worksheet.functions)
  • Re: Expiry of Excel shee
    ... ' expiration date. ... ' MsgBox is displayed and this workbook is closed. ... Dim ExpirationDate As String ... Change C_REG_KEY to a registry key name that ...
    (microsoft.public.excel.worksheet.functions)
  • RE: Viewing Names
    ... someone elses workbook to bypass their protection? ... I have two macros, one creates a Name called 'Expiration Date', and the ... to extend. ...
    (microsoft.public.excel.worksheet.functions)
  • Re: trial period
    ... I have a workbook, i would like to give a Trial Period of 7 days, ... U can use the Windows registry. ... Dim DateInst As Date ... Please contact blah blah blah" ...
    (microsoft.public.excel.programming)