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

Essentially, what you are alluding to is this:
http://www.cpearson.com/excel/workbooktimebomb.aspx

There are other variations on this idea. This is probably the best though.

HTH,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"Hardeep kanwar" 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

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/sh...ad.php?t=80570

A link to a much simpler version can be found here
http://tinyurl.com/cruplb to access the download you will have to take a
moment join the forum but it's entirely free!


--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)
------------------------------------------------------------------------
Simon Lloyd's Profile: http://www.thecodecage.com/forumz/member.php?userid=1
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=80570

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/sh...ad.php?t=80570

Simon Lloyd;288394 Wrote:
A link to a much simpler version can be found here
http://tinyurl.com/cruplb to access the download you will have to take a
moment join the forum but it's entirely free!

Thanks Sir

Now, i got this

Private Sub Workbook_Open()
If Date = "26/09/08" Then
MsgBox "Trial period has expired please call John Doe", vbOKOnly,
"Trial Period Expired"
ThisWorkbook.Close (False)
End If
End Sub

As i already mentioned that i am totally stupid in Macros and VBA

Secondly, I want to Expired my Sheet with in a minutes i.e after open
the sheet it will expire after 5 Minute.

Thanks in Advance

Hardeep kanwar


--
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

hardeep.kanwar;288649 Wrote:
Thanks Sir

Now, i got this

Private Sub Workbook_Open()
If Date = "26/09/08" Then
MsgBox "Trial period has expired please call John Doe", vbOKOnly,
"Trial Period Expired"
ThisWorkbook.Close (False)
End If
End Sub

As i already mentioned that i am totally stupid in Macros and VBA

Secondly, I want to Expired my Sheet with in a minutes i.e after open
the sheet it will expire after 5 Minute.

Thanks in Advance

Hardeep kanwar

Hardeep, thats a workbook event macro and it's entered like this
*How to Save a Workbook Event Macro*
1. *Copy* the macro using *CTRL+C* keys.
2. Open your Workbook and *Right Click* on any *Worksheet's Name Tab*
3. *Left Click* on *View Code* in the pop up menu.
4. Press *ALT+F11* keys to open the *Visual Basic Editor.*
5. Press *CTRL+R* keys to shift the focus to the *Project Explorer
Window*
6. Press the *Down Arrow Key* until *ThisWorkbook* is highlighted in
blue.
7. *Press* the *Enter* key to move the cursor to the *Code Window*
8. *Paste* the macro code using *CTRL+V*
9. *Save* the macro in your Workbook using *CTRL+S*To use a
timer to time how long the workbook is open you would have to use the
OnTime event read up on it here 'Pearson Software Consulting'
(http://www.cpearson.com/excel/OnTime.aspx)


--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)
------------------------------------------------------------------------
Simon Lloyd's Profile: http://www.thecodecage.com/forumz/member.php?userid=1
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=80570

Simon Lloyd;288779 Wrote:
Hardeep, thats a workbook event macro and it's entered like this
*How to Save a Workbook Event Macro*
1. *Copy* the macro using *CTRL+C* keys.
2. Open your Workbook and *Right Click* on any *Worksheet's Name Tab*
3. *Left Click* on *View Code* in the pop up menu.
4. Press *ALT+F11* keys to open the *Visual Basic Editor.*
5. Press *CTRL+R* keys to shift the focus to the *Project Explorer
Window*
6. Press the *Down Arrow Key* until *ThisWorkbook* is highlighted in
blue.
7. *Press* the *Enter* key to move the cursor to the *Code Window*
8. *Paste* the macro code using *CTRL+V*
9. *Save* the macro in your Workbook using *CTRL+S*To use a
timer to time how long the workbook is open you would have to use the
OnTime event read up on it here 'Pearson Software Consulting'
(http://www.cpearson.com/excel/OnTime.aspx)

Sir, Is it possible to Replace Date With Time

Like: 00:00:30

that means After 30 Seconds it will Corrupted the Sheet ands will not
open even from the mail.

thanks in Advance


--
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

hardeep.kanwar;288889 Wrote:
Sir, Is it possible to Replace Date With Time

Like: 00:00:30

that means After 30 Seconds it will Corrupted the Sheet ands will not
open even from the mail.

thanks in Advance
You cannot "corrupt" or whatever any excel file that is an attachment,
you can only manipulate it once its downloaded and opened, it is easy to
stop a macro running when opening Excel so if you are trying to protect
your workbook and contents this way you will be disappointed!

Timing is done via the ontime method as described at Chip Pearsons
site, the problem is if you allow them to view the workbook at all then
the sheets will be unhidden and they may crash the code and be able to
carry one viewing the workbook!


--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)
------------------------------------------------------------------------
Simon Lloyd's Profile: http://www.thecodecage.com/forumz/member.php?userid=1
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=80570

Simon Lloyd;289007 Wrote:
You cannot "corrupt" or whatever any excel file that is an attachment,
you can only manipulate it once its downloaded and opened, it is easy to
stop a macro running when opening Excel so if you are trying to protect
your workbook and contents this way you will be disappointed!

Timing is done via the ontime method as described at Chip Pearsons
site, the problem is if you allow them to view the workbook at all then
the sheets will be unhidden and they may crash the code and be able to
carry one viewing the workbook!

Thanks Sir,

From this post i have learn lots of things

thanks Again

Hardeep Kanwar


--
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

hardeep.kanwar;289073 Wrote:
Thanks Sir,

From this post i have learn lots of things

thanks Again

Hardeep Kanwar
There are some things you can do, use the code you have along with
http://www.thecodecage.com/forumz/do...macro-use.html then
if then you can use the Ontime method as shown at Chip Pearsons site to
hide all the sheets except the welcome sheet after 5 minutes

*How To Say Thanks!*
If you have found my tip helpful then please click on the
button (like the one on the left) to the bottom right of my post to
register your appreciation


--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)
------------------------------------------------------------------------
Simon Lloyd's Profile: http://www.thecodecage.com/forumz/member.php?userid=1
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=80570

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
' 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/sh...ad.php?t=80570

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

hardeep.kanwar;290286 Wrote:
Thanks for Reply

Problem is Solved:)

Thanks again

If you feel it may help others then please tell us what your solution
was. if a particular post was helpful then click the thumbs up on that
post....in future a post marked helpful may help others in your
situation.


Glad we could be of help!


*How To Say Thanks!*
If you have found my tip helpful then please click on the
button (like the one on the left) to the bottom right of my post to
register your appreciation


--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)
------------------------------------------------------------------------
Simon Lloyd's Profile: http://www.thecodecage.com/forumz/member.php?userid=1
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=80570

Simon Lloyd;290349 Wrote:
If you feel it may help others then please tell us what your solution
was. if a particular post was helpful then click the thumbs up on that
post....in future a post marked helpful may help others in your
situation.


Glad we could be of help!


*How To Say Thanks!*
If you have found my tip helpful then please click on the
button (like the one on the left) to the bottom right of my post to
register your appreciation

I Found this
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As
Long)
Private Sub Workbook_Open()
Dim wks As Worksheet
If Time = "00.00.10" Then
Sleep 10000
MsgBox "Trial period has expired please call John Doe", vbOKOnly,
"Trial Period Expired"
For Each wks In ActiveWorkbook.Worksheets
wks.Cells.ClearContents
Next wks
ThisWorkbook.Close (True)
End If
End Sub

Hardeep kanwar


--
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