Hi Everyone

I have created an input box which prompts a user for a password before
opening a spreadsheet, however although the input box displays ********* the
characters are overwritten when the password is typed in

Is there a way to display ******* as the password is being entered?

Hi,

It's a lot easier to do it with a text box on a userform and set the textbox
passowrd character to mask the input but heres a method to do it with an
input box. The functions go in a general module and the sub at the end can go
in as worksheet code or a module and is provided to show how to call the
code. the original author is credited in the code.

Option Explicit

''/////////////////////////////////////////////////////////////////
''// 25 May 2003 //
''// Amended Ivan F Moala
''// Call with myresponse=InPutBoxPwd(etc
''// from any module
''/////////////////////////////////////////////////////////////////

Public Declare Function GetActiveWindow _
Lib "user32" () _
As Long

Public Declare Function FindWindowEx _
Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) _
As Long

Public Declare Function SendMessage _
Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long

Public Declare Function SetTimer _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) _
As Long

Public Declare Function KillTimer _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long) _
As Long

Public Declare Function GetForegroundWindow _
Lib "user32" () _
As Long


Private Const nIDE As Long = &H100
Private Const EM_SETPASSWORDCHAR = &HCC

Private hdlEditBox As Long
Private Fgrndhdl As Long

Public Function TimerFunc( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal nEvent As Long, _
ByVal nSecs As Long) As Long

Dim hdlwndAct As Long

'// Do we have a handle to the EditBox
If hdlEditBox 0 Then Exit Function

'// Get the handle to the ActiveWindow
hdlwndAct = GetActiveWindow()

'// Get the Editbox handle
hdlEditBox = FindWindowEx(hdlwndAct, 0, "Edit", "")

'// Set the password character for the InputBox
SendMessage hdlEditBox, EM_SETPASSWORDCHAR, Asc("*"), ByVal 0

End Function

Public Function InPutBoxPwd(fPrompt As String, _
Optional fTitle As String, _
Optional fDefault As String, _
Optional fXpos As Long, _
Optional fYpos As Long, _
Optional fHelpfile As String, _
Optional fContext As Long) As String

Dim sInput As String

'// Initialize
hdlEditBox = 0
Fgrndhdl = GetForegroundWindow
'// Windows-Timer
SetTimer Fgrndhdl, nIDE, 100, AddressOf TimerFunc

'// Main InputBox
If fXpos Then
sInput = InputBox(fPrompt, fTitle, fDefault, fXpos, fYpos,
fHelpfile, fContext)
Else
sInput = InputBox(fPrompt, fTitle, fDefault, , , fHelpfile, fContext)
End If

'// Kill the correct Timer
KillTimer Fgrndhdl, nIDE
'// Pass result
InPutBoxPwd = sInput

End Function

'////////////////////////////////////////////////////
'// This is The main routine
'// where we test it
'////////////////////////////////////////////////////

Sub GetPassWord()
Dim x As String

x = InPutBoxPwd("Please enter password", "Sentry")
If x = vbNullString Then
MsgBox "User Cancelled"
Else
MsgBox "User entered " & x
End If

End Sub

"stephenc" wrote:

Hi Everyone

I have created an input box which prompts a user for a password before
opening a spreadsheet, however although the input box displays ********* the
characters are overwritten when the password is typed in

Is there a way to display ******* as the password is being entered?

Thanks very much Mike :-)

"Mike H" wrote:

Hi,

It's a lot easier to do it with a text box on a userform and set the textbox
passowrd character to mask the input but heres a method to do it with an
input box. The functions go in a general module and the sub at the end can go
in as worksheet code or a module and is provided to show how to call the
code. the original author is credited in the code.

Option Explicit

''/////////////////////////////////////////////////////////////////
''// 25 May 2003 //
''// Amended Ivan F Moala
''// Call with myresponse=InPutBoxPwd(etc
''// from any module
''/////////////////////////////////////////////////////////////////

Public Declare Function GetActiveWindow _
Lib "user32" () _
As Long

Public Declare Function FindWindowEx _
Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) _
As Long

Public Declare Function SendMessage _
Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long

Public Declare Function SetTimer _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) _
As Long

Public Declare Function KillTimer _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long) _
As Long

Public Declare Function GetForegroundWindow _
Lib "user32" () _
As Long


Private Const nIDE As Long = &H100
Private Const EM_SETPASSWORDCHAR = &HCC

Private hdlEditBox As Long
Private Fgrndhdl As Long

Public Function TimerFunc( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal nEvent As Long, _
ByVal nSecs As Long) As Long

Dim hdlwndAct As Long

'// Do we have a handle to the EditBox
If hdlEditBox 0 Then Exit Function

'// Get the handle to the ActiveWindow
hdlwndAct = GetActiveWindow()

'// Get the Editbox handle
hdlEditBox = FindWindowEx(hdlwndAct, 0, "Edit", "")

'// Set the password character for the InputBox
SendMessage hdlEditBox, EM_SETPASSWORDCHAR, Asc("*"), ByVal 0

End Function

Public Function InPutBoxPwd(fPrompt As String, _
Optional fTitle As String, _
Optional fDefault As String, _
Optional fXpos As Long, _
Optional fYpos As Long, _
Optional fHelpfile As String, _
Optional fContext As Long) As String

Dim sInput As String

'// Initialize
hdlEditBox = 0
Fgrndhdl = GetForegroundWindow
'// Windows-Timer
SetTimer Fgrndhdl, nIDE, 100, AddressOf TimerFunc

'// Main InputBox
If fXpos Then
sInput = InputBox(fPrompt, fTitle, fDefault, fXpos, fYpos,
fHelpfile, fContext)
Else
sInput = InputBox(fPrompt, fTitle, fDefault, , , fHelpfile, fContext)
End If

'// Kill the correct Timer
KillTimer Fgrndhdl, nIDE
'// Pass result
InPutBoxPwd = sInput

End Function

'////////////////////////////////////////////////////
'// This is The main routine
'// where we test it
'////////////////////////////////////////////////////

Sub GetPassWord()
Dim x As String

x = InPutBoxPwd("Please enter password", "Sentry")
If x = vbNullString Then
MsgBox "User Cancelled"
Else
MsgBox "User entered " & x
End If

End Sub

"stephenc" wrote:

Hi Everyone

I have created an input box which prompts a user for a password before
opening a spreadsheet, however although the input box displays ********* the
characters are overwritten when the password is typed in

Is there a way to display ******* as the password is being entered?