Solved

Password Mask in INPUT BOX for VBA

Posted on 2011-02-13
18
44,658 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 50 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 67 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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
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 67 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 66 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

Independent Software Vendors: 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!

Question has a verified solution.

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

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

615 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