RyGuy;290236 Wrote:
Can you download the example Chip has on his site? I already sent you
the
link. Copy/paste your data into that downloaded file. Does that work
for
you, or do you have lots and lots of functions, other code, etc., that
you
can't transport to the downloaded file.

HTH,
Ryan---


"Hardeep kanwar" wrote:

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
' 'Registry Functions' (http://www.cpearson.com/Excel/Registry.htm)
or
' www.cpearson.com/Excel/Registry.aspx
' or the RegistryWorx DLL from
' 'RegistryWorx'
(http://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'
('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: 'The Code Cage Forums - View Profile:
Pecoflyer' (http://www.thecodecage.com/forumz/member.php?userid=14)
View this thread: 'Expiry of Excel shee - The Code Cage Forums'
(http://www.thecodecage.com/forumz/sh...ad.php?t=80570)



Thanks for Reply

Problem is Solved:)

Thanks again


--
hardeep.kanwar
------------------------------------------------------------------------
hardeep.kanwar's Profile: http://www.thecodecage.com/forumz/member.php?userid=170
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=80570