How to make masked password character inputbox to MS-Excel/MS-Access.

Sometime we need to enter password via inputbox for many reason. Microsoft excel or access do not have any inputbox to take input password. It take input as clear text and any user can see the password while typing. We can make it in two way. We can create a data input form having Text Box and specify property to mask input character as start (*) or other symbol. Another way is to write custom VBA function to do this. I will show how to write custom VBA function to mask inputbox character. Lets start.

1. First open a new workbook.

2. Open VBA code window (Alt+F11).

3. Insert a new module (Follow the below screenshot).

4. Copy and paste below codes to this module. You can also download codes from this link.

'======================= Code Start ======================

Option Explicit

Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, _

    ByVal ncode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr

Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _

    (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr

Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr

Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _

(ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, _

ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr

Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr

Private Const EM_SETPASSWORDCHAR = &HCC

Private Const WH_CBT = 5

Private Const HCBT_ACTIVATE = 5

Private Const HC_ACTION = 0

Private hHook As LongPtr

Public Function NewProc(ByVal lngCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

    Dim RetVal

    Dim strClassName As String, lngBuffer As LongPtr

    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)

        If Left$(strClassName, RetVal) = "#32770" Then

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

        End If

    End If

    CallNextHookEx hHook, lngCode, wParam, lParam

End Function

Public Function PasswordBox(Prompt, Title) As String

    Dim lngModHwnd As LongPtr, lngThreadID As LongPtr

    lngThreadID = GetCurrentThreadId

    lngModHwnd = GetModuleHandle(vbNullString)

    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

    PasswordBox = InputBox(Prompt, Title)

    UnhookWindowsHookEx hHook

End Function

'================= Code End ===================

5. Then make a public sub to call the PasswordBox function. You can call the function like below.

Sub TestPasswordBox()

    Range("A1") = PasswordBox("Enter password to test.", "Password Box")

End Sub

Sample File Download Link.

E-Mail: harun24hr@gmail.com

Read More