Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Password Mask in INPUT BOX for VBA

Posted on 2011-02-13
18
Medium Priority
?
48,394 Views
Last Modified: 2012-05-11
I need the characters entered in the InputBox to be Password masked,

Example:
Dim Password
Password = InputBox("Enter Your Password:")

When the user enters password, it should be masked with * symbol
0
Comment
Question by:srikanthv2322
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 2
  • 2
  • +3
18 Comments
 
LVL 33

Expert Comment

by:jppinto
ID: 34883044
The inputbox does not accept a mask, for that you will need to make an input form with a masked textbox.

jppinto
0
 
LVL 33

Assisted Solution

by:jppinto
jppinto earned 200 total points
ID: 34883053
Here's the confirmation from Microsoft that this can«t be done using an InputBox:

http://msdn.microsoft.com/en-us/library/Aa164894

jppinto
0
 
LVL 45

Accepted Solution

by:
patrickab earned 268 total points
ID: 34883217
srikanthv2322,

Try the attached file - code below.

If in the Userform you select the TextBox and look at its Properties you will see that the Password character has been set to *. That means that whenever you press a key only an asterix will be shown in the TextBox. When you press the 'Use password' button it checks whether you have entered the correct password. If the password is correct the Userform will be hidden and unloaded.

In practice you of course need to lock the VBA project so that people cannot just read the VBA code to find out what the password is.

Patrick
Private Sub CommandButton1_Click()
If LCase(Me.TextBox1.Text) = "qwerty" Then
    MsgBox "Password was correct"
    Me.Hide
    Unload Me
Else
    MsgBox "Password was incorrect"
End If
End Sub

Open in new window

password-masking-01.xls
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34883354
If I am not wrong then you can achieve what you want...

Let me create an example for you...

Sid
0
 
LVL 30

Assisted Solution

by:SiddharthRout
SiddharthRout earned 268 total points
ID: 34883371
Sample Attached.

Sid

Code Used

Calling the Input Box

Sub Sample()
    Dim Prompt, password As String
    Prompt = InputBoxDK("Please enter you password.")
End Sub

Open in new window


Code in a Module

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 InputBoxDK(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

Open in new window

Input-Box-with-Password-Char.xls
2
 
LVL 42

Assisted Solution

by:dlmille
dlmille earned 264 total points
ID: 34883737
I never thought about UserForm.  Will have to try that.  I currently use Sid's approach (not saying which is better).

As far as storing the password?  Take this code and put it into an addIn!  You can lock the VBA Project on that addIn, and still make your workbook application public for users....

Attached - Here's the InputBox method as an addIn in two files.


Here's a link on creating an addin from Cpearson's website: http://www.cpearson.com/excel/createaddin.aspx

Dave

Routine like Sid created (it calls the password masking function)

Just like Sid's example, except the function for the password is in the AddIn:

Private Sub CommandButton1_Click()
    If getPasswordUsingInputBoxDK("Please enter you password") Then
        'proceed with code
        MsgBox "password accepted", vbOKOnly
    Else
        'perhaps prompt again in a loop, or fail out?
        MsgBox "password failed", vbCritical
    End If
End Sub

Open in new window


The add-in containing the password masking function (password stored here is "MyPassword" and you can distribute this, AFTER locking VBA Project (note passwords can be broken):

 
Function getPasswordUsingInputBoxDK(myPromptForPassword As String) As Boolean
Dim Prompt As String
    
    Prompt = InputBoxDK(myPromptForPassword)
    If Prompt <> "MyPassword" Then
        MsgBox "Invalid Password", vbCritical
        getPasswordUsingInputBoxDK = False
    Else
        getPasswordUsingInputBoxDK = True
    End If

End Function

Open in new window


Just download both files in a directory.  Add the add-in to your add-ins library, and reference the addin in the workbook.  Or you can load the add-in on demand.  However, the workbook needs to reference the add-in via Excel Options - or Tools/Reference (in the VBA Project area).

InputBxPasswd-AddIn.xla
AppCallingPasswordFcn-r1.xls
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 34886907
FWIW, the above code ought to be attributed to Daniel Klann, I believe.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34886940
I always wondered who wrote that code. Could never find it out. Have been using it for couple of years now...

Thanks for the info. Is he a MVP, Rory?

Sid
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 34886947
Not that I am aware of, though he may have been. His site seems to have disappeared.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34886960
No wonder I could never find out. Thanks Rory.

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34984571
@srikanthv2322: Could you please explain your Choice of answer?

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34984610
The code that I gave above does what you want. Please check the sample that I have attached.

Sid
0
 
LVL 42

Expert Comment

by:dlmille
ID: 34984938
I'm curious too.  How can "confirm can't be done" be an answer, when a solution was provided...

Perhaps the wrong answer was checked???

Cheers,

dave
0
 
LVL 45

Expert Comment

by:patrickab
ID: 34986683
srikanthv2322,

Please explain your choice of 'Accepted' answer as it does not provide a solution to your question. In fact it even says it cannot be achieved with an InputBox and gives a link to an MS site which confirms it cannot be done that way.

Patrick
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34988212
modus_operandi: There were 3 solutions provided in this thread. By me, Patrick and David.

Sid
0
 
LVL 1

Expert Comment

by:zmau
ID: 35317320
Are these points or dollars ?
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Ready to improve network connectivity? Watch this webinar to learn how SD-WANs and a one-click instant connect tool can boost provisions, deployment, and management of your cloud connection.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

With User Account Control (UAC) enabled in Windows 7, one needs to open an elevated Command Prompt in order to run scripts under administrative privileges. Although the elevated Command Prompt accomplishes the task, the question How to run as script…
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

704 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question