Timer to Protect a Workbook

[ShyD]

Hi,

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, but, if the user already has the password, he can simply press a button and insert it, canceling the timer

Ideas?

Sorry for the english xD

 

[breadzeppelin]

Hi ShyD,

Perhaps not the most elegant way, but you could achieve what you're after with the following approach:

1). Ensure that only 1 sheet is available when a user opens the workbook (all others should remain very hidden until a password has been provided, unless one is not required of course)
2). Also - Create a hidden/very hidden password lists sheet with your password(s) and when they are effective from
3). Use an "on open" macro to check the current date against the effective date of the expected password
4). The macro should check if a). a password exists and b). if it matches the expected password.
5). If a successful password is entered, this could be stored in the password lists sheet to be checked when the file is opened again. All sheets that were hidden can be set to visible using a macro
6). If an invalid password is entered, then the macro would exit and the user could be notified with a message (if desired).

Let me know if this is clear; if not - I should have an example workbook I could send over that might help.

Oz

 

[ShyD]

Hello I came to a code that can meet my need, it is very basic due to my knowledge, here it is, if possible indications of improvements.

Sub Auto_Open()

If Range("A1") = "" Then
   Range("A1").Value = Now
    Dim DataIni As Date
        DataIni = Range("A1").Value
        
  MsgBox "Obrigado por baixar nossas planilhas, você terá 7 dias de periodo de avaliação, após o periodo será necessário inserir a senha.", vbInformation, "ProPulse Social Media"
    
    Else
    Dim DataIniConf As Date
        DataIniConf = Range("A1").Value
        
    Dim Expirado As Date
        Expirado = DateAdd("d", 7, DataIniConf)
        Range("A2").Value = Expirado
     If Range("A3") = "OK" Then Exit Sub
        Range("A3") = Now
     If Range("A3") > Expirado Then
        
    Dim wsheet As Worksheet
    For Each wsheet In ActiveWorkbook.Worksheets
        wsheet.Protect Password:="propulse"
    Next wsheet
        
  MsgBox "A planilha está bloqueada!"
  
    End If
    End If
    End Sub

And this for unprotect sheets

Sub unprotectsheets()

Dim Senha As String
Senha = InputBox("Insira sua senha", "ProPulse Social Media")

If Senha = "propulse" Then



Dim wsheet As Worksheet
For Each wsheet In ActiveWorkbook.Worksheets
wsheet.Unprotect Password:="propulse"
Next wsheet
MsgBox "Planilhas Desbloqueadas", vbInformation, "ProPulse Social Media"
Sheets(1).Select
Range("A3").Value = "OK"
Else
MsgBox "Senha Incorreta", vbCritical, "ProPulse Social Media"

End If

End Sub