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) (http://www.mrexcel.com/forum/excel-questions/43144-inputbox-password.html)

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