Password chars on Inputbox

[RichardMGreen]

Hi guys

I'm looking for a way of entering a password to ensure someone is entitled to run a mcaro. I've got the code sort for that, but the password is written on screen when you type it.
I've seen this thread :-
http://www.mrexcel.com/forum/showthread.php?t=308923
which hides the password using * but on a userform.
Can you do the same thing on an inputbox, or can someone suggest something similar without using userforms?

 

[MarkAndrews]

Richard, why not simply use

If Environ("Username") = "andrewm" then
 
Your code here

or

[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]Private Sub workbook_open()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]Dim x As String<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]x = Environ(“Username”)<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]Select Case x<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]    Case "andrewm", "gallagd"<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]        Application.ScreenUpdating = False<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]*<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]*<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]*<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]        Application.ScreenUpdating = True<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]    Case Else<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]        Exit Sub<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]End Select<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]
[FONT=Verdana][SIZE=1][COLOR=black][COLOR=black][FONT=Verdana]End Sub<o:p></o:p>[/FONT][/COLOR][/COLOR][/SIZE][/FONT]

 

[RichardMGreen]

Duh!!!
Thanks for that - never even thought of doing it that way!

 

[MarkAndrews]

Duh!!!
Thanks for that - never even thought of doing it that way!

Anytime, to help a fellow Yorkshireman out!

 

[northwolves]

A solution with API:

'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
 Dim 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
   Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, Optional YPos, Optional HelpFile, Optional Context) As String
   Dim lngModHwnd  As Long
   Dim 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

 Sub macro1()
 InputBoxDK "Please enter the password", "Info", "123456"
 End Sub

Best Regards
Northwolves