PDA

View Full Version : Solved: InputBox Help



TBS2766
03-25-2011, 12:08 PM
I have the following code password protect a checkbox so that only authorized users can check the box, which in turn runs a macro.

Private Sub CheckBox1_Click()
Dim Password As String
Dim Inpass As String
Const PWD As String = "hi"
'checks to make sure authorized password is entered before checking box
If CheckBox1 = True Then
End If
Inpass = Application.InputBox("Please Enter Password to Proceed. Enter To Cancel.")
If Inpass = "" Or Inpass <> PWD Then
CheckBox1 = False
MsgBox "Not Authorized"
Else
CheckBox1 = True
End If
End Sub

This works swimmingly except I would like when the inputbox is displayed for the user entered password to be encrypted or masked so that if anyone standing nearby cannot see the value being entered. If it cannot be done then I will run the code as is.

I would appreciate any help with this matter, as I continue to experiment with this new VBA language I recently discovered. Thanks!

BrianMH
03-25-2011, 12:16 PM
quick search of google finds http://www.tek-tips.com/faqs.cfm?fid=4617

TBS2766
03-25-2011, 12:31 PM
Thanks, I came across this while I was searching too but I am new to VBA and don't exactly understand all of it. I am currently using it as a template for trial and error, but would greatly appreciate any expertise into adapting it to suite my needs.

BrianMH
03-25-2011, 01:17 PM
Option Explicit

'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'March 2003
'////////////////////////////////////////////////////////////////////


'API functions to be used
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 'A window has been activated

RetVal = GetClassName(wParam, strClassName, lngBuffer)

If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox

'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

Function InputBoxDK(Prompt, Title) 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)
UnhookWindowsHookEx hHook

End Function



Found this and tested it. Post this into a module and then change your code to.

Private Sub CheckBox1_Click()
Dim Password As String
Dim Inpass As String
Const PWD As String = "hi"
'checks to make sure authorized password is entered before checking box
If CheckBox1 = True Then
End If
Inpass = InputBoxDK("Please Enter Password to Proceed. Enter To Cancel.","Password Prompt")
If Inpass = "" Or Inpass <> PWD Then
CheckBox1 = False
MsgBox "Not Authorized"
Else
CheckBox1 = True
End If
End Sub

courtesy of http://www.mrexcel.com/forum/showthread.php?t=43144

TBS2766
03-28-2011, 12:32 PM
Thanks so much...works perfectly:wavey: :hifive: