Password to open form

tigger2

New member
Local time
Today, 12:46
Joined
Apr 29, 2005
Messages
2
Hi, I'm trying to protect a single form with a password. I've set up a control button which then opens a pop-up with a field to enter the password, OK and cancel control buttons, but just can't get started with the macro to control it. Please help, I'm nearly bald with the amount of hair I've pulled out over this! Alternative suggestions will be gratefully received.
 
Welcome to the forum!

You need to dump the macro approach and jump into the sea of VBA. User's are also encouraged to search the forum before posting. Your question has been asked and answered in many threads.

You can cheaply and quickly add a function to the OnClick event of your buttons to force the user to input the correct password into an Input Box if they want to access [open a form, report, etc]. You can search this forum for examples of all of the above. The code below will show you how to do it...
Code:
    Dim strInput As String
    Dim strMsg As String
    
    Beep
    strMsg = "This form is used only by the ''Special Form'' people." & vbCrLf & vbLf & "Please key the ''Special Form'' password to allow access."
    strInput = InputBox(Prompt:=strMsg, title:="Special Password")
    If strInput = "SpecialFormPassword" Then 'password is correct
        DoCmd.OpenForm "YourSpecialFormNameHere"
        DoCmd.Close acForm, Me.Name
    Else 'password is incorrect
        MsgBox "Incorrect Password!" & vbCrLf & vbLf & "You are not allowed access to the ''Special Form''.", vbCritical, "Invalid Password"
        Exit Sub
    End If
You can format an Input Box with astericks **** but it takes a ton of code. Search the forum with the keyword "InputBoxDK" if you really need to do it.

The above is a simple way to call an input box that allows the user to key a password and if correct it will open a form. Assign the code to the OnClick event of the button to open the form that you want password protected.
 
Thank you so much, I think I knew I needed to use VBA, but I'm a complete novice so couldn't work out how to adapt the other answers to fit.

Hazel :)
 
ghudson said:
You can format an Input Box with astericks **** but it takes a ton of code. Search the forum with the keyword "InputBoxDK" if you really need to do it.
I did a search for "InputBoxDK" - the only post that came up was the one I'm replying to... ?
 
Here is the module that Ghudson was talking about
Code:
Option Explicit
[COLOR=Green]
'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'http://www.danielklann.com/
'March 2003

'// Kindly permitted to be amended
'// Amended by Ivan F Moala
'// [url]http://www.xcelfiles.com[/url]
'// April 2003
'// Works for Xl2000+ due the AddressOf Operator
'////////////////////////////////////////////////////////////////////

'********************   CALL FROM FORM *********************************
'    Dim pwd As String
'
'    pwd = InputBoxDK("Please Enter Password Below!", "Database Administration Security Form.")
'
'    'If no password was entered.
'    If pwd = "" Then
'        MsgBox "You didn't enter a password!  You must enter password to 'enter the Administration Screen!" _
'        , vbInformation, "Security Warning"
'    End If
'**************************************[/COLOR]



'API functions to be used
Private Declare Function CallNextHookEx _
    Lib "user32" ( _
    ByVal hHook As Long, _
    ByVal ncode As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
As Long

Private Declare Function GetModuleHandle _
    Lib "kernel32" _
    Alias "GetModuleHandleA" ( _
    ByVal lpModuleName As String) _
As Long

Private Declare Function SetWindowsHookEx _
    Lib "user32" _
    Alias "SetWindowsHookExA" ( _
    ByVal idHook As Long, _
    ByVal lpfn As Long, _
    ByVal hmod As Long, _
    ByVal dwThreadId As Long) _
As Long

Private Declare Function UnhookWindowsHookEx _
    Lib "user32" ( _
    ByVal hHook As Long) _
As Long

Private Declare Function SendDlgItemMessage _
    Lib "user32" Alias "SendDlgItemMessageA" ( _
    ByVal hDlg As Long, _
    ByVal nIDDlgItem As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) _
As Long

Private Declare Function GetClassName _
    Lib "user32" _
    Alias "GetClassNameA" ( _
    ByVal hWnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) _
As Long

Private Declare Function GetCurrentThreadId _
    Lib "kernel32" () _
As Long

'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As Long

Public Function NewProc(ByVal lngCode As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long) As Long

Dim RetVal
Dim strClassName As String, lngBuffer As Long

If lngCode < HC_ACTION Then
    NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
    Exit Function
End If

strClassName = String$(256, " ")
lngBuffer = 255

If lngCode = HCBT_ACTIVATE Then    'A window has been activated
    RetVal = GetClassName(wParam, strClassName, lngBuffer)
    If Left$(strClassName, RetVal) = "#32770" Then  'Class name of the Inputbox
        'This changes the edit control so that it display the password character *.
        'You can change the Asc("*") as you please.
        SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
    End If
End If
    
'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx hHook, lngCode, wParam, lParam

End Function

'// Make it public = avail to ALL Modules
'// Lets simulate the VBA Input Function
Public Function InputBoxDK(Prompt As String, Optional Title As String, _
            Optional Default As String, _
            Optional Xpos As Long, _
            Optional Ypos As Long, _
            Optional Helpfile As String, _
            Optional Context As Long) As String
    
Dim lngModHwnd As Long, lngThreadID As Long
    
'// Lets handle any Errors JIC! due to HookProc> App hang!
On Error GoTo ExitProperly
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
    
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
If Xpos Then
    InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
Else
    InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
End If

ExitProperly:
UnhookWindowsHookEx hHook

End Function

Sub TestDKInputBox()
Dim x

x = InputBoxDK("Type your password here.", "Password Required")
If x = "" Then End
If x <> "yourpassword" Then
    MsgBox "You didn't enter a correct password."
    End
End If

MsgBox "Welcome Creator!", vbExclamation
    
End Sub


Hooks
 
Last edited:
HOLY CRAP!!! I think it would just be easier to create a custom form!!! :) As much as I'd like to know about the Windows API, I don't need to know it that much yet... :)

Thanks!!
 
You can format an Input Box with astericks **** but it takes a ton of code. Search the forum with the keyword "InputBoxDK" if you really need to do it.
Told you so. :p

Anything would be better than using an input box. The code works and the olny effort you have to make is to copy and paste it into a module. There is only one call make. Just run the Sub TestDKInputBox() sub at the bottom of the code and see how easy it is to call it.
 
Last edited:
I just tried it - pretty cool. Most of the time, though, I want a username and a password - that just looks better on a custom form!

I'll file that code away as interesting, maybe useful someday!

Thanks
 
Input Box with astericks ****

Hi,

I am new at using VB and am creating a database for work. I have a form that
has an administrator button that once clicked prompts you for a password. Here is the code that I entered for that and it works fine.


Private Sub Administration_Click()
Dim strInput As String
Dim strMsg As String

Beep
strMsg = "This form is used only by the ''Administrator''." & vbCrLf & vbLf & "Please key in password to allow access."
strInput = InputBox(Prompt:=strMsg, Title:="Admin Password")
If strInput = "Admin_Password" Then 'password is correct
DoCmd.OpenForm "Administration"
DoCmd.Close acForm, Me.Name
Else 'password is incorrect
MsgBox "Incorrect Password!" & vbCrLf & vbLf & "You are not allowed access to ''Administration''.", vbCritical, "Invalid Password"
Exit Sub

End Sub


But I want to add this Iput Box with astericks *** and copied and modified the code (see what I have below)that was in this thread and pasted it in underneath what I already have, but it doesn't work it comes up with an error see attached pic. How can I incorporate this code so that this will work?
MANY THANKS


Option Explicit

Private Declare Function CallNextHookEx _
Lib "user32" ( _
ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long

Private Declare Function GetModuleHandle _
Lib "kernel32" _
Alias "GetModuleHandleA" ( _
ByVal lpModuleName As String) _
As Long

Private Declare Function SetWindowsHookEx _
Lib "user32" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) _
As Long

Private Declare Function UnhookWindowsHookEx _
Lib "user32" ( _
ByVal hHook As Long) _
As Long

Private Declare Function SendDlgItemMessage _
Lib "user32" Alias "SendDlgItemMessageA" ( _
ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long

Private Declare Function GetClassName _
Lib "user32" _
Alias "GetClassNameA" ( _
ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) _
As Long

Private Declare Function GetCurrentThreadId _
Lib "kernel32" () _
As Long

Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As Long

Public Function NewProc(ByVal lngCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Dim RetVal
Dim strClassName As String, lngBuffer As Long

If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If

strClassName = String$(256, " ")
lngBuffer = 255

If lngCode = HCBT_ACTIVATE Then 'A window has been activated
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, RetVal) = "Admin Password" Then

SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
End If

CallNextHookEx hHook, lngCode, wParam, lParam

End Function


Public Function InputBoxDK(Prompt As String, Optional Title As String, _
Optional Default As String, _
Optional Xpos As Long, _
Optional Ypos As Long, _
Optional Helpfile As String, _
Optional Context As Long) As String

Dim lngModHwnd As Long, lngThreadID As Long

On Error GoTo ExitProperly
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)

hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
If Xpos Then
InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
Else
InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
End If

ExitProperly:
UnhookWindowsHookEx hHook

End Function

Sub TestDKInputBox()
Dim x

x = InputBoxDK("Type your password here.", "Password Required")
If x = "" Then End
If x <> "Admin_Password" Then
MsgBox "You didn't enter a correct password."
End
End If

MsgBox "Welcome Administrator!", vbExclamation

End Sub
 

Attachments

  • Only Comments.jpg
    Only Comments.jpg
    22.3 KB · Views: 608
Comment out the error handling so you get the error dialog and then you can run the code, get the error, and click the Debug button and it should take you to the offending code.
 
Compile Error

I am trying to use GHudsons code (post #5 by Hooks) - for hashed password entry via the Inputbox funtion shown above - but when I run (in 97) - I get an error on the AddressOf operator - according to the help files - 97 no longer supports it use....?????

Here is the function call :
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

Does anyone know of a workaround for this problem please? (upgrading Access which would be the simplest option at this time - is not an option at present).....

Thank you in advance for any help.
 
Last edited:
Hi, this looks like the kind of thing i need :), where would the code go? and how would it verify the passwords? where would they be kept?? thank you
 
my concern is about where to store those passwords securely...
or just use hashed password and make the hash function not easy to find..
really confused, anybody could stand to voice out? thanks
 
If you want the inputbox characters to "hide".
You only choose it in the properties for the inputbox.
(properties>data>inDataMask>choose-password)
I am not sure of the correct english expression (norwegian...):)
 
Why can't you just have a "password form" when opened runs a "go to control" with is a textbox of zero height, width and zero from left....and type in pass word and click button etc.

Simple to make and more secure than * as an oberver can't even tell the number of key strokes:D
 
I am using Access 2007. How does the above code apply to A07? Here is what I am tring to do:
I would like to set a password for a database in Access 2007, and also set an additional (or different) password for a particular form and table that contain financial data, that I don't want all users to use.
Is this possible? If so can someone please provide details.

Thanks
Ron
 
You can't set a password for a table. You could use user group security in prevous version of access but the discontinued this feature 2007.
 
You can't set a password for a table. You could use user group security in prevous version of access but the discontinued this feature 2007.

Only if you use the ACCDB format. If you use the MDB format, you can still use User Level Security in Access 2007.
 
Passwords

Okay, you can't set a password for a form. What about the rest of my question? How to set a pasword on a form.
 

Users who are viewing this thread

Back
Top Bottom