akinkaraman
Member
Great
There are 4 cases so make sure you check them all
Sir what are those 4 cases?
Great
There are 4 cases so make sure you check them all
Public MyDate As Variant
Public Passwd As String
Private Sub WorkBook_Open()
MyDate = #2/22/2015# ' Assign a date.
Passwd = "ABCD" 'Assign password
If Date > MyDate Then
Application.ScreenUpdating = False
Sheets("Intro").Visible = True
Sheets("Clock").Visible = xlVeryHidden
Application.ScreenUpdating = True
MsgBox "Oops! Test/Evaluation period of the utility has been expired." & vbCrLf & _
"Pls ask the concern person to get the updated utility.", vbCritical, "Outdated/Expired Version"
mbox = Application.InputBox("Pls input the password/code to continue...", "Password")
If mbox <> Passwd Then
MsgBox "Incorrect Password" & vbCrLf & _
"Pls ask the concern person to get the correct password.", vbCritical, "Wrong password"
Application.Quit
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
Else
Sheets("Clock").Visible = True
Sheets("Intro").Visible = False
End If
End If
End Sub
Well done sir. But i tried to use this code for a file and after the expiring date, i opened that file and there is no any PROMPT.I think this code finally works fine.
Code:Public MyDate As Variant Public Passwd As String Private Sub WorkBook_Open() MyDate = #2/22/2015# ' Assign a date. Passwd = "ABCD" 'Assign password If Date > MyDate Then Application.ScreenUpdating = False Sheets("Intro").Visible = True Sheets("Clock").Visible = xlVeryHidden Application.ScreenUpdating = True MsgBox "Oops! Test/Evaluation period of the utility has been expired." & vbCrLf & _ "Pls ask the concern person to get the updated utility.", vbCritical, "Outdated/Expired Version" mbox = Application.InputBox("Pls input the password/code to continue...", "Password") If mbox <> Passwd Then MsgBox "Incorrect Password" & vbCrLf & _ "Pls ask the concern person to get the correct password.", vbCritical, "Wrong password" Application.Quit With ThisWorkbook .Save .ChangeFileAccess Mode:=xlReadOnly Kill .FullName .Close SaveChanges:=False End With Else Sheets("Clock").Visible = True Sheets("Intro").Visible = False End If End If End Sub
Please explain how you would do this please when a secure password is applied to both the opening sequence within the VBA and also the VBA itself.No true protection in Excel : can be bypassed in a few seconds …
Please explain how you would do this please when a secure password is applied to both the opening sequence within the VBA and also the VBA itself.
thanks
Is there a better suggestion as to how to properly protect your VBA programming from others? Thank you.Hey! VBA easily possible in XL 2007 while opening password is good stuff but still not power proof for who wish to crack it.
Is this password put once or it has to be put every time a document is opened?You could try something like this.
Code:Private Sub WorkBook_Open() Dim edate As Date, mbox As Variant, myuser As String, wbuser As String Application.ScreenUpdating = False edate = DateSerial(2015, 2, 25) If Date > edate Then MsgBox "Oops! Test/Evaluation period of the utility has been expired." & vbCrLf & _ "Pls ask the concern person to get the updated utility.", vbCritical, "Outdated/Expired Version" mbox = Application.InputBox("Pls input the password/code to continue...", "Password") If mbox <> "ABCD" Then ThisWorkbook.Close False End If End Sub
Hello.I think this code finally works fine.
Code:Public MyDate As Variant Public Passwd As String Private Sub WorkBook_Open() MyDate = #2/22/2015# ' Assign a date. Passwd = "ABCD" 'Assign password If Date > MyDate Then Application.ScreenUpdating = False Sheets("Intro").Visible = True Sheets("Clock").Visible = xlVeryHidden Application.ScreenUpdating = True MsgBox "Oops! Test/Evaluation period of the utility has been expired." & vbCrLf & _ "Pls ask the concern person to get the updated utility.", vbCritical, "Outdated/Expired Version" mbox = Application.InputBox("Pls input the password/code to continue...", "Password") If mbox <> Passwd Then MsgBox "Incorrect Password" & vbCrLf & _ "Pls ask the concern person to get the correct password.", vbCritical, "Wrong password" Application.Quit With ThisWorkbook .Save .ChangeFileAccess Mode:=xlReadOnly Kill .FullName .Close SaveChanges:=False End With Else Sheets("Clock").Visible = True Sheets("Intro").Visible = False End If End If End Sub
Thanks for the code it was really helpful but is there a code that allows you to auto renew your licence or expiry period after password is entered for an expired file??You could try something like this.
Code:Private Sub WorkBook_Open() Dim edate As Date, mbox As Variant, myuser As String, wbuser As String Application.ScreenUpdating = False edate = DateSerial(2015, 2, 25) If Date > edate Then MsgBox "Oops! Test/Evaluation period of the utility has been expired." & vbCrLf & _ "Pls ask the concern person to get the updated utility.", vbCritical, "Outdated/Expired Version" mbox = Application.InputBox("Pls input the password/code to continue...", "Password") If mbox <> "ABCD" Then ThisWorkbook.Close False End If End Sub