disable shift open key

saretta000 · Feb 21, 2009

hi!
I'd like to use the AllowByPassKey to disable shift open key, because I'd like to hide tables and modules to users of my db. However, since my db is a database for dataentry, I need to be able to view and access to tables and modules, after users have entered data! So I need something that can disable shift_open key, but also re-enable it!
I wrote the following working function, which is run by an autoexec macro in my db:

Function sara_shift_open()

Dim db As Database
Dim prop As Property
Dim PropBool As Boolean
Const PropNotFound = 3270

Err = 0
Set db = CurrentDb()
PropBool = False
On Error GoTo CatturaErrore
db.Properties("AllowByPassKey") = PropBool 'Disable shift key

'Using the file unlock_shift.txt as "password": if the file is present on the machine (@C:\), then the shift_open key is enable. Otherwise, it's disable (on my PC the file will be present, so I will be able to enable shift_open key so to access tables).
NomeFile = "C:\unlock_shift.txt"
Err = 0
On Error Resume Next
Open NomeFile For Input As #1 'Open file: if the file doesn't exist, error 53 is returned
If Err = 0 Then
PropBool = True
db.Properties("AllowByPassKey") = PropBool 'enable shift key
Close #1 'close file
End If

CatturaErrore:
If Err = PropNotFound Then
Set prop = db.CreateProperty("AllowByPassKey", 1, PropBool)
db.Properties.Append prop
Err = 0
Resume Next
End If

End Function

I know it may be a stupid way to use AllowByPassKey property, but it's the simpler and quicker solution I found, and I think it well works!!!

What I'm kindly asking is: in your opinion will it always well work????

I don't trust a lot of access ( sorry for that

please forgive me!

).

I'm not an expert user, and it's mandatory for me to be able to access to db tables and code.
May I be sure that my function will always work and that I will always be able to enable shift_open key if the file.txt that I use as "password" is present on my machine?
Or I did some omissions/mistakes which could compromise its working in some particular occasions?

thank you in advance for your help!
sara.

RuralGuy · Feb 21, 2009

It looks like it would work just fine but the style is somewhat strange. There are ways to check for the existance of a file for example that do not open the file. Your exit is *always* through the error routine.

Poppa Smurf · Feb 21, 2009

Create a linked "unlocked" copy of the database for your own use or you could use a database called SetDatabaseProperties SetDatabaseProperties located at this site http://www.rogersaccesslibrary.com/forum/forum_posts.asp?TID=170

This database allows you to change the properties of a selected database.

saretta000 · Feb 22, 2009

Dear RuralGuy,
thank you for your comment! I know it's strange, I will search the way to check the existence of a file without opening it! I wrote this code in 5 minutes, so I used the few command I had in mind!

The condition exit... yes, for sure you're right! I will change it!

Dear Poppa Smurf,
thank you for your suggestion, I will have a look at the link!

Modified: here is my new code, a little bit less raw!

Function sara_shift_open()

Dim db As Database
Dim prop As Property
Dim PropBool As Boolean
Const PropNotFound = 3270

Set db = CurrentDb()
PropBool = False
On Error GoTo CatturaErrore
db.Properties("AllowByPassKey") = PropBool 'Disable shift key

'using a file.txt as password: I verify if the file exists
NomeFile = "C:\unlock_shift.txt"
If Not esiste = Dir(NomeFile) Then
PropBool = True
db.Properties("AllowByPassKey") = PropBool 'enable shift key if the file.txt exists
End If

CatturaErrore:
If Err = PropNotFound Then
Set prop = db.CreateProperty("AllowByPassKey", 1, PropBool)
db.Properties.Append prop
Resume Next
End If
End Function

If someone else has some comments about my raw (I admit it!

) but practical code, please let me know!
I wouldn't like to be trapped in my locked version of db!

Thank you again in advance!
sara

Rabbie · Feb 22, 2009

You are still always exiting through your error code. Why?

saretta000 · Feb 22, 2009

Dear Rabbie,
I'm not sure I understand what you mean...
If I do as follows?

Function sara_shift_open()

Dim db As Database
Dim prop As Property
Dim PropBool As Boolean
Const PropNotFound = 3270

Set db = CurrentDb()
PropBool = False
On Error GoTo CatturaErrore
db.Properties("AllowByPassKey") = PropBool 'Disable shift key
CatturaErrore:
If Err = PropNotFound Then
Set prop = db.CreateProperty("AllowByPassKey", 1, PropBool)
db.Properties.Append prop
Resume Next
End If

'using a file.txt as password: I verify if the file exists
NomeFile = "C:\unlock_shift.txt"
If Not esiste = Dir(NomeFile) Then
PropBool = True
db.Properties("AllowByPassKey") = PropBool 'enable shift key if the file.txt exists
End If

End Function

Thanks in advance!

RuralGuy · Feb 22, 2009

I think something like the following should work but WARNING it is untested air code.

Code:

Function sara_shift_open()

   Dim db As DAO.Database
   Dim prop As Property
   Const PropNotFound = 3270

   Set db = CurrentDb()
   On Error GoTo CatturaErrore

   db.Properties("AllowByPassKey") = False   'Disable shift key

   '  Using the file unlock_shift.txt as "password":
   '    if the file is present on the machine (@C:\),
   '    then the shift_open key is enable.
   '    Otherwise, it's disable (on my PC the file will be present,
   '    so I will be able to enable shift_open key so to access tables).

   If Dir("C:\unlock_shift.txt") <> "" Then
      db.Properties("AllowByPassKey") = True   'enable shift key
   End If

CatturaExit:
   On Error Resume Next
   Set db = Nothing
   Exit Function

CatturaErrore:
   If Err = PropNotFound Then
      Set prop = db.CreateProperty("AllowByPassKey", dbBoolean, True, True)
      db.Properties.Append prop
      Resume Next
   Else
      Resume CatturaExit
   End If

End Function

saretta000 · Feb 22, 2009

Thank you,
I understood!
Sorry for being raw in writing codes! I'm not at all an expert user!

thank you again!
sara.

RuralGuy · Feb 22, 2009

You're certainly welcome Sara.

823 · Feb 1, 2025

Hi,

This thread is a bit aged….but I would need the same thing.

I found this code on the post above, but it seems doesn’t works:

Code:

Function sara_shift_open()

   Dim db As DAO.Database
   Dim prop As Property
   Const PropNotFound = 3270

   Set db = CurrentDb()
   On Error GoTo CatturaErrore

   db.Properties("AllowByPassKey") = False   'Disable shift key

   '  Using the file unlock_shift.txt as "password":
   '    if the file is present on the machine (@C:\),
   '    then the shift_open key is enable.
   '    Otherwise, it's disable (on my PC the file will be present,
   '    so I will be able to enable shift_open key so to access tables).

   If Dir("C:\unlock_shift.txt") <> "" Then
      db.Properties("AllowByPassKey") = True   'enable shift key
   End If

CatturaExit:
   On Error Resume Next
   Set db = Nothing
   Exit Function

CatturaErrore:
   If Err = PropNotFound Then
      Set prop = db.CreateProperty("AllowByPassKey", dbBoolean, True, True)
      db.Properties.Append prop
      Resume Next
   Else
      Resume CatturaExit
   End If

End Function

I need a code (that I can insert into a new vba module) that disable shift key when db opens, but when file “shifkey.txt”
Is available in c:\ the shift key will be enabled.

Can you help me plz?

Thanks in advance

theDBguy · Feb 1, 2025

823 said:

Hi,

This thread is a bit aged….but I would need the same thing.

I found this code on the post above, but it seems doesn’t works:

Code:

Function sara_shift_open()

   Dim db As DAO.Database
   Dim prop As Property
   Const PropNotFound = 3270

   Set db = CurrentDb()
   On Error GoTo CatturaErrore

   db.Properties("AllowByPassKey") = False   'Disable shift key

   '  Using the file unlock_shift.txt as "password":
   '    if the file is present on the machine (@C:\),
   '    then the shift_open key is enable.
   '    Otherwise, it's disable (on my PC the file will be present,
   '    so I will be able to enable shift_open key so to access tables).

   If Dir("C:\unlock_shift.txt") <> "" Then
      db.Properties("AllowByPassKey") = True   'enable shift key
   End If

CatturaExit:
   On Error Resume Next
   Set db = Nothing
   Exit Function

CatturaErrore:
   If Err = PropNotFound Then
      Set prop = db.CreateProperty("AllowByPassKey", dbBoolean, True, True)
      db.Properties.Append prop
      Resume Next
   Else
      Resume CatturaExit
   End If

End Function

I need a code (that I can insert into a new vba module) that disable shift key when db opens, but when file “shifkey.txt”
Is available in c:\ the shift key will be enabled.

Can you help me plz?

Thanks in advance

What does "doesn't work" mean? I think changing the Shift Bypass property may require a restart, so have you tried closing the app and reopening it again with the Shift key?

823 · Feb 1, 2025

yes, I've insert that code into a new vba module and restart the db many times, but shift key is always active.

Maybe something to set into the code or something to change?

Please note that my db has FE and BE, but I think It should do not interest this.

DHookom · Feb 1, 2025

Does your actual file name match your code but when file “shifkey.txt”?

823 · Feb 1, 2025

Yes of course.

To avoid error I didn’t modified “unlock_shift.txt” in the code.
And i’ve created (an deleted) unlock_shift.txt on c:\

Josef P. · Feb 1, 2025

Thinking briefly in a different direction:
Does it necessarily have to go through the undo_shift.txt bypass?
Wouldn't it be easier to remove the shift lock from the outside and set it again later?

DHookom · Feb 1, 2025

823 said:
Yes of course.

To avoid error I didn’t modified “unlock_shift.txt” in the code.
And i’ve created (an deleted) unlock_shift.txt on c:\

So, your file name is shifkey.txt not shiftkey.txt?

823 · Feb 2, 2025

Filename is ok.
Try that code in your db…. It will not works

Gasman · Feb 2, 2025

You need that as an autoexec, have you done that?
A simple function name is not going to work unless you call it from the autoexec?

Gasman · Feb 2, 2025

823 said:
Filename is ok.
Try that code in your db…. It will not works

Have you even tried to walk the code?

Gasman · Feb 2, 2025

Run this code and see what properties you do have?

Code:

Public Sub ShowDbProps()
On Error GoTo Err_btnShowDbProps_Click

  Dim prp As DAO.Property
  Dim dbs As Database
  Dim strProps As String

  Set dbs = CurrentDb

  For Each prp In dbs.Properties
    Dim propval As String
    propval = "<not defined>"

    On Error Resume Next
    propval = CStr(prp.value)

    If propval = vbNullString Then propval = "<empty>"

    strProps = strProps & prp.Name & "=" & propval & " (" & PropertyType(prp.Type) & ")" & vbNewLine
    Debug.Print strProps
  Next

  MSGBOX strProps

Exit_btnShowDbProps_Click:
    Exit Sub

Err_btnShowDbProps_Click:
    MSGBOX Err.Description
    Resume Exit_btnShowDbProps_Click

End Sub

disable shift open key

New member

AWF VIP

Registered User.

New member

Super Moderator

New member

AWF VIP

New member

AWF VIP

Member

I’m here to help

Member

Active member

Member

Well-known member

Active member

Member

Enthusiastic Amateur

Enthusiastic Amateur

Enthusiastic Amateur

Similar threads

Users who are viewing this thread