Vba code that creates an input mask for a password ***** in an input box

[emmorel]

I want my input box to display asterisks ****** instead of text when password is entered. I tried several suggestions but I'm still getting the text showing. Below is my vba code:
Is there a function for an input mask that can be placed after InputBox() below. I'd appreciate anyone's help on this. Thanks. emmorel

Private Sub CmdMaintain_Click()
'Attached to On Click event of cmdMaintain
Dim strPasswd
    strPasswd = InputBox("Enter Password", "Restricted Form")    
'Check to see if there is any entry made to input box, or if
    'cancel button is pressed. If no entry made then exit sub.
If strPasswd = "" Or strPasswd = Empty Then
    MsgBox "No Input Provided", vbInformation, "Required Data"
    Exit Sub
    End If
'If correct password is entered open Employees form
    'If incorrect password entered give message and exit sub
If strPasswd = "maintain" Then
    DoCmd.OpenForm "frmMaintenance", acNormal
    Else
    MsgBox "Sorry, you do not have access to this form", _
    vbOKOnly, "Important Information"
    Exit Sub
    End If
End Sub

[SamT]

I moved this to the Excel Forum only because It is the most popular forum.

[SamT]

Change sub cmdMaintain like this

Private Sub CmdMaintain_Click()
'Attached to On Click event of cmdMaintain
frmPasswordGetter.Show
End Sub

Sub PasswordChecker(strPasswd as String)
    If strPasswd = "" Or strPasswd = Empty Then
        MsgBox "No Input Provided", vbInformation, "Required Data"
        Exit Sub
    End If

    'If correct password is entered open Employees form
    'If incorrect password entered give message and exit sub

    If strPasswd = "maintain" Then
        DoCmd.OpenForm "frmMaintenance", acNormal
    Else
        MsgBox "Sorry, you do not have access to this form", _
               vbOKOnly, "Important Information"
        Exit Sub
    End If
End Sub

frmPasswordGetter has one textbox,"tbxPassword" and one command button

Dim strPasswd as String
Dim strAsterisks As String

Sub tbxPassword_Change()

strAsterisks = strAsterisks & "*"

strPassword = strPassword & Right(tbxPassword.Txt, 1)
tbxPassword.Txt = Asterisks
End Sub

Sub CommandButton_click()
PasswordChecker strPasswd
Unload Me
End Sub

I would add a CommandButton, "cbutClear" to reset strAsterisks and strPassword

[GTO]

I barely know how to spell Access, but I would probably use a form like Sam is showing. If you are bent on an InputBox, you could try:

In a Standard Module:

Option Explicit
  
'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'March 2003
'////////////////////////////////////////////////////////////////////


'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
  
Function InputBoxDK(Prompt, Title) As String
    Dim lngModHwnd As Long, lngThreadID As Long


    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
    
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)


    InputBoxDK = InputBox(Prompt, Title)
    UnhookWindowsHookEx hHook


End Function
  
Sub examplePassword()
  MsgBox "I entered: " & InputBoxDK("Please enter a password", "Password Required"), vbInformation, vbNullString
End Sub

...as shown by DK Here (post #3)

I would check and include any needed declarations (if needed) for 64-bit if that is a concern or may be later.

Mark

[emmorel]

Thanks SamT, I cut and paste your code but I must be doing something wrong because I'm getting an error; you see I'm learning Vba by using existing coding and I'm just learning the order of commands. Where exactly to I place the bottom part of the Vba code that begins with DIM, I thought this usually is placed at the top.

Thanks.
emmorel

[Paul_Hossler]

Thanks SamT, I cut and paste your code but I must be doing something wrong because I'm getting an error; you see I'm learning Vba by using existing coding and I'm just learning the order of commands. Where exactly to I place the bottom part of the Vba code that begins with DIM, I thought this usually is placed at the top.l

Try

tbxPassword.Text = Asterisks

[SamT]

Thanks Paul, I missed that one.

Emmorel,

My bad. In all my editing and moving things around and changing Variable names, I missed changing one name.

In this code

Dim strPasswd As String 
Dim strAsterisks As String 
 
Sub tbxPassword_Change() 
     
    strAsterisks = strAsterisks & "*" 
     
    strPassword = strPassword & Right(tbxPassword.Txt, 1) 
    tbxPassword.Txt = Asterisks 
End Sub 
 
Sub CommandButton_click() 
    PasswordChecker strPasswd 
    Unload Me 
End Sub

Change
tbxPassword.Txt = Asterisks to tbxPassword.Txt = strAsterisks

Where exactly to I place the bottom part of the Vba code that begins with DIM, I thought this usually is placed at the top.

Any variable that are Declared, (Dim,) inside a sub can only be referred to inside that sub, even if the same name is used somewhere else. Variables that are Declared with "Dim" outside all subs, at the top of the code page, can be referred to inside any sub on that code page.

I put

 
Dim strPasswd As String 
Dim strAsterisks As String

At the top of the Code Page for the Password Getter UserForm, because they are used by both sub in the Form and because they keep their values until you close the form, even after the TextBox Change sub exits.





ps: when you get an error, always tell us what the error message is.

[mohsenmrds]

Thanks Paul, I missed that one.

Emmorel,

My bad. In all my editing and moving things around and changing Variable names, I missed changing one name.

In this code

Dim strPasswd As String 
Dim strAsterisks As String 
 
Sub tbxPassword_Change() 
     
    strAsterisks = strAsterisks & "*" 
     
    strPassword = strPassword & Right(tbxPassword.Txt, 1) 
    tbxPassword.Txt = Asterisks 
End Sub 
 
Sub CommandButton_click() 
    PasswordChecker strPasswd 
    Unload Me 
End Sub

Change
tbxPassword.Txt = Asterisks to tbxPassword.Txt = strAsterisks



Any variable that are Declared, (Dim,) inside a sub can only be referred to inside that sub, even if the same name is used somewhere else. Variables that are Declared with "Dim" outside all subs, at the top of the code page, can be referred to inside any sub on that code page.

I put

 
Dim strPasswd As String 
Dim strAsterisks As String

At the top of the Code Page for the Password Getter UserForm, because they are used by both sub in the Form and because they keep their values until you close the form, even after the TextBox Change sub exits.





ps: when you get an error, always tell us what the error message is.

Thanks Paul, I missed that one.

Emmorel,

My bad. In all my editing and moving things around and changing Variable names, I missed changing one name.

In this code

Dim strPasswd As String 
Dim strAsterisks As String 
 
Sub tbxPassword_Change() 
     
    strAsterisks = strAsterisks & "*" 
     
    strPassword = strPassword & Right(tbxPassword.Txt, 1) 
    tbxPassword.Txt = Asterisks 
End Sub 
 
Sub CommandButton_click() 
    PasswordChecker strPasswd 
    Unload Me 
End Sub

Change
tbxPassword.Txt = Asterisks to tbxPassword.Txt = strAsterisks



Any variable that are Declared, (Dim,) inside a sub can only be referred to inside that sub, even if the same name is used somewhere else. Variables that are Declared with "Dim" outside all subs, at the top of the code page, can be referred to inside any sub on that code page.

I put

 
Dim strPasswd As String 
Dim strAsterisks As String

At the top of the Code Page for the Password Getter UserForm, because they are used by both sub in the Form and because they keep their values until you close the form, even after the TextBox Change sub exits.





ps: when you get an error, always tell us what the error message is.

Hi
Thx for brilliant CODE
1. this line:
strAsterisks = strAsterisks & "*"
fills all of the text box with * character so it doesn't let type any password so instead of that I used the textbox with inputmask in properties of the text box (actually password inputmask ) and deleted this line. and used only below line instead:
Private SubtbxPassword_Change()
strPasswd = tbxPassword.Text
End Sub

2. I changed the strPassword with strPasswd and tbxPassword.Txt with tbxPassword.Text

rest of the code works nice for me,
thanks again dear Sam T