Timer to Lock a Workbook

[GarySmith]

I'm looking for a timer that will lock a workbook. I want to send someone a file, upon opening, an agreement check box appears that says, "Click Here to Start Your Preview". After say, 7 days, the workbook will lock and will not open again without a password entry. Once the password is entered, the file may be freely used.

Ideas anyone?

 

[ZAX]

I'm looking for a timer that will lock a workbook. I want to send someone a file, upon opening, an agreement check box appears that says, "Click Here to Start Your Preview". After say, 7 days, the workbook will lock and will not open again without a password entry. Once the password is entered, the file may be freely used.

Ideas anyone?

You mean when you check the check box,the file will be sent (Some how*) and the timer will start??
*Some how:is it by an Email?
if not then where should the file be sent and how?
ZAX

 

[GarySmith]

Actually, the scenario would be:

I send a file.

The recipient opens the file.

At that point, upon opening a short pop up notifies the user that access is good for {some time} ( let's say 7 days) and after the 7 days the file locks down as it now cannot be accessed without entering a password.

Once the password is entered, the file is permanently accessible.

 

[ZAX]

Actually, the scenario would be:

I send a file.

The recipient opens the file.

At that point, upon opening a short pop up notifies the user that access is good for {some time} ( let's say 7 days) and after the 7 days the file locks down as it now cannot be accessed without entering a password.

Once the password is entered, the file is permanently accessible.

Copy this code to an ordinary module and you can replace the "MyPassword" with the password you want,But you better try it on a test file...(Just for being careful)
And one more thing,you don't need to run this code or type it in the workbooks code,it will run automatically on opening the workbook.

Sub Auto_Open()
i = i + 1
If IsEmpty(Sheets(1).Cells(Rows.Count, Columns.Count)) = False Then
   If Sheets(1).Cells(Rows.Count, Columns.Count).Value = Now Then
      ActiveWorkbook.Protect "MyPassword"
      MsgBox "The workbook is now protected!"
   End If
Else
   Sheets(1).Cells(Rows.Count, Columns.Count).Value = DateAdd("d", 7, Now)
End If
If i = 1 Then
   MsgBox "After you've opened the file,You'll be able to get access to it for 7 days and then it well be locked with a password", vbCritical, "User"
End If
End Sub

 

[GarySmith]

Update:

• Created test file.

• Added to Module

• Customized specific test message and password (changed time {date function} to 1 day) [to speed up test]

• Opened file and received popup message
• Will report beta test.

Now, thinking out loud; make the messages count down the days left?

• Have the counter change the message as the days count down from first day file is opened. (example: In this scenerio, after the first day, the popup would, on opening, read, "You have 7 days to use this file.") then, when 6 days are left (You have 6 days left) , etc, etc

 

[ZAX]

Then I understand that the first code worked as expected,Yeah!
Hope this one works too

Sub Auto_Open()
If IsEmpty(Sheets(1).Cells(Rows.Count, Columns.Count)) = False Then
   If Sheets(1).Cells(Rows.Count, Columns.Count).Value = Now Then
      ActiveWorkbook.Protect "MyPassword"
      MsgBox "The workbook is now protected!"
   End If
Else
   Sheets(1).Cells(Rows.Count, Columns.Count).Value = DateAdd("d", 7, Now)
End If
   MsgBox "You've got " & DateDiff("d", Sheets(1).Cells(Rows.Count, Columns.Count).Value, Now) & _
   " days to get access to the file without a password", vbCritical, "User"
End Sub

ZAX

 

[GarySmith]

Test resulted in this image:

Error Message pic.twitter.com/KGZWiV9X3D

 

[ZAX]

Test resulted in this image:

Error Message pic.twitter.com/KGZWiV9X3D

The code worked perfectly for me,just replace this line of code (to show positive value)!

   MsgBox "You've got " & VBA.Abs(DateDiff("d", Sheets(1).Cells(Rows.Count, Columns.Count).Value, Now)) & _
   " days to get access to the file without a password", vbCritical, "User"

P.S:I can't access to twitter,Plz Just tell me where is the error occurring (in which line of code) and what is the error's text.

ZAX

 

[GarySmith]

Here's what I get?

Pardon me, but your code is not exactly the same. See the code above:

Now))

??

 

[ZAX]

Plz REPLACE the msgbox line in the old code with the code above to get the positive value using VBA.Abs(),you're getting -1 and the above code will make it 1.
Here's how the code will be,simply copy it:

Sub Auto_Open()
If IsEmpty(Sheets(1).Cells(Rows.Count, Columns.Count)) = False Then
   If Sheets(1).Cells(Rows.Count, Columns.Count).Value = Now Then
      ActiveWorkbook.Protect "MyPassword"
      MsgBox "The workbook is now protected!"
   End If
Else
   Sheets(1).Cells(Rows.Count, Columns.Count).Value = DateAdd("d", 7, Now)
End If
   MsgBox "You've got " & VBA.Abs(DateDiff("d", Sheets(1).Cells(Rows.Count, Columns.Count).Value, Now)) & _
   " days to get access to the file without a password", vbCritical, "User"
End Sub

ZAX