Solved

Password Mask in INPUT BOX for VBA

Posted on 2011-02-13
18
33,785 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
1
 
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

863 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

25 Experts available now in Live!

Get 1:1 Help Now