Protecting Passwords and Workbook expiration date

[dizzy]

Hi,

I am asking everybody if there is a VBA command that can rewrite or modify an existing VBA line from the same “Sub”. :banghead:

I have created a Sub that allows accessing the file before and including “Mydate” value knowing the password.

I need an VBA line or lines(marked with?????) that can change the actual password details when file is accesses after the date passed “Mydate” value. The reason I am asking is because some “people” can think to change the system date details then they can access the file at anytime.

Thank you in advance.

See below Sub details:




Sub WORKBOOK_OPEN()

Dim Mydate As Date
Mydate = DateValue("November 01,2014")
If Date > Mydate Then
??????????????????????????
??????????????????????????
??????????????????????????
ThisWorkbook.Save
Application.DisplayAlerts = False
ThisWorkbook.Close
Else
Pword = "type a password here"
End If
Response = InputBox("Enter Password to continue", "Password")
If Response <> Pword Then
Application.DisplayAlerts = False
ThisWorkbook.Close
Exit Sub
Else
Call nextsub
End If
End Sub

[Bob Phillips]

Save the details to a hidden sheet or a hidden defined name and modify that rather than trying to amend the VBA.

[dizzy]

Hi xld,

Thank you for your response, actually as you mentioned about hidden sheet and modify you gave me an idea.

You are correct, I don’t need to amend the VBA, I will split the VBA in few Sub’s then based on Date value I will create another Sub that will delete the Sub with the password details, problem solved :thumb

When finished I will post the VBA code

[Aussiebear]

If the problem is solved, then go to Thread tools and use the dropdown "Mark this thread as Solved'

[dizzy]

Unfortunately is not solved yet Aussiebear, I have the VBA code that can remove another Module in this case the module with the password details and that is solved.

The issue now is when I password protect the VBA(I need to do that to avoid another user changing the settings) the Sub cant remove Module2.

There is others VBA command that can remove a module with the VBA password on? Or any others ideas? Please….. help…:banghead:

The reason I want the Module 2 to be removed permanently when time expire is to avoid any users that may change the Date of the Windows system and that will make the file accessible at any time.

I have attached my excel file

[Paul_Hossler]

I'd still go with something that doesn't involve re-writing the workbook. Assumes the VBA project is protected, and that this is only strong enough to guard against the very casual user

1. In the real workbook object I added a Open event that checks the date and PW of a VeryHidden sheet. Personally I'd think you would want to ask for the PW first so you could get to it, and if the user didn't enter the correct PW then check the expiration date. Two .Close lines are comment out for now

2. The expiration date and the pw stored on the very hidden worksheet are VERY slightly scrambled to protect against the casual user with a hex editor



Option Explicit
Private Sub Workbook_Open()
Dim MyDate As Date
Dim Pword As String, Response As String
Dim i As Long
Dim aPwordChar As Variant
'access the very hidden worksheet
With ThisWorkbook.Worksheets("__other")

.Visible = xlVeryHidden

'decode stored date
MyDate = DateSerial(.Range("A1").Value - 150, .Range("B1").Value - 75, .Range("C1").Value - 25)
If Date > MyDate Then
'uncomment ThisWorkbook.Close (False)
Else
'decode stored password
aPwordChar = Array(3, 5, 7, 11, 13, 17, 19, 23, 29)

i = 1
Do While .Cells(4, i).Value <> 0
Pword = Pword & Chr(.Cells(4, i).Value - aPwordChar(i - 1))
i = i + 1
Loop

Response = InputBox("Enter Password to continue", "Password")
If Response <> Pword Then
'uncomment ThisWorkbook.Close (False)
Else
' from here you can carry on the project if not expired
Call finalprojectSub
End If
End If
End With
End Sub




3. You need to know the names of the hidden macros to show and hide the special sheet. Probably change them in case your users read VBAexpress



Option Explicit
Option Private Module

Sub ShowSheet()
ThisWorkbook.Worksheets("__other").Visible = xlSheetVisible
End Sub

Sub HideSheet()
ThisWorkbook.Worksheets("__other").Visible = xlSheetVeryHidden
End Sub

[Kenneth Hobs]

Why don't you use something more simple? You could store a value in a cell, environment variable, registry, file, etc. and then check that.

[Paul_Hossler]

Why don't you use something more simple? You could store a value in a cell, environment variable, registry, file, etc. and then check that.

Me?

Data is stored in cells on a VeryHidden sheet. Registry and environment and separate file are not very portable so I thought of keeping everything in a single WB

Hidden names would also work, but I was thinking of someone with a hex editor / viewer might browse and start trying strings

[Kenneth Hobs]

No, I replied before your post Paul. You are too fast....

[Paul_Hossler]

:thumb

[dizzy]

Thank you Paul for your VBA code, i will try it and let you know.

[dizzy]

Paul I did add an extra code(below) to yours and now when the date expired the VeryHidden sheet is removed file saved and closed without any possibility for another user to use the sheet without knowing the VBA password and repair VeryHidden sheet

Thank you again for your help, now this Topic will be marked as [SOLVED]


ThisWorkbook.Worksheets("__other").Visible = xlSheetVisible
Application.DisplayAlerts = False
Sheets("__other").Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Save
ThisWorkbook.Close



Option ExplicitPrivate Sub Workbook_Open()
Dim MyDate As Date
Dim Pword As String, Response As String
Dim i As Long
Dim aPwordChar As Variant
'access the very hidden worksheet
With ThisWorkbook.Worksheets("__other")

.Visible = xlVeryHidden

'decode stored date
MyDate = DateSerial(.Range("A1").Value - 150, .Range("B1").Value - 75, .Range("C1").Value - 25)
If Date > MyDate Then
ThisWorkbook.Worksheets("__other").Visible = xlSheetVisible
Application.DisplayAlerts = False
Sheets("__other").Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Save
ThisWorkbook.Close
'uncomment ThisWorkbook.Close (False)
Else
'decode stored password
aPwordChar = Array(3, 5, 7, 11, 13, 17, 19, 23, 29)

i = 1
Do While .Cells(4, i).Value <> 0
Pword = Pword & Chr(.Cells(4, i).Value - aPwordChar(i - 1))
i = i + 1
Loop

Response = InputBox("Enter Password to continue", "Password")
If Response <> Pword Then
'uncomment ThisWorkbook.Close (False)
Else
' from here you can carry on the project if not expired
Call finalprojectSub
End If
End If
End With
End Sub

[Paul_Hossler]

I would expect

ThisWorkbook.Worksheets("__other")


to generate a Subscript error if someone re-opens the file after __other was deleted