Input box password in asterisks

[AmanKaur123]

Hi Guys

I am just trying to type Password in Asterisks in Input box using the following code. This code helps me to type asterisks which is great but when I want to check this password against the password in the Access table then that doesn't work.

This code is written in a module which works fine:

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
        RetVal = GetClassName(wParam, strClassName, lngBuffer)
        '~~> Class name of the Inputbox
        If Left$(strClassName, RetVal) = "#32770" Then
            '~~> 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
Public Function InputBoxPassword(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) 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, Default, XPos, YPos, HelpFile, Context)
    UnhookWindowsHookEx hHook
End Function

The following code is written in a module too which is invoked on the click event of the command button on the form and the message "2" appears that means it retrives null string from the Input box . Please see below the code:

Option Compare Database
Public Function SendAgent(frmName As String, cboValue As String) As Boolean
Dim I As String
Dim StaffNum As Long
If MsgBox("Do you wish to send this form to " & cboValue & " to sign off?", vbQuestion + vbYesNo, "Send to Agent?") = vbYes Then
Do While SendAgent = False
I = InputBoxPassword("Enter your Unique passKey", "Password")
MsgBox I
StaffNum = DLookup("[Staff Number]", "tblstaff", "struser='" & NameofUser() & "'")
j = DLookup("PassKey", "tbl_RMS_PassKey", "UserID='" & NameofUser() & "'")
If StrComp(I, j, vbBinaryCompare) = 0 Then
MsgBox "1"
SendAgent = True

ElseIf I = vbNullString Then  

MsgBox "2"
SendAgent = False
Exit Function
Else
'SendAgent = False
MsgBox "3"
MsgBox "Wrong PassKey,Please try again"
End If
Loop
Else
MsgBox "4"
SendAgent = False
End If
End Function
Public Sub SendEmail(s As String, cboValue As String, Ref As String)
    
    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)
    With MailOutLook
    
    '.To = DLookup("[Email]", "qry_Function_LMEmail", "[Staff Number] = " & cboValue)
    .To = DLookup("[Email]", "tblstaff", "[Staff Number] = " & cboValue)
   
    .Subject = s & " needs to be signed off"
    .Body = " form has been completed by " & DLookup("[Staff Name]", "tblstaff", "struser='" & NameofUser() & "'") & vbCrLf & vbCrLf & "The Reference number is " & Ref & " Please review and signoff."
    .sEnd
    End With
End Sub

Thanks

[Bulzie]

Can you just use input mask of Password on the field so when they enter a value it will show as astericks? Is that what you are trying to do?

[andy49]

Why not just change the input mask for the text box.


Sent from my iPhone using Tapatalk

[AmanKaur123]

Guys, the input box now accepts asterisks which is good but how can I retrieve its value and check against some other value to make sure if the password is correct or not. When I try to retrieve the value from it then it gives me null string. Any suggestions in this anyone?

I know one option is to build Input form from scratch and set the Input mask property of the textbox but just wondering if I can use the already existing Input box instead of creating a form .

Thanks

[Bulzie]

The users are not entering asterisks, those are just hiding the actual characters typed. The password value in that password box should be there if you reference that field.

[AmanKaur123]

Thanks guys. I have now designed a form which looks exactly like Input box and does the purpose.