Solved

Password Mask in INPUT BOX for VBA

Posted on 2011-02-13
18
31,375 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
  • 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
 
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
0
 
LVL 41

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
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
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 41

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

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Suggested Solutions

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

757 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

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now