Here is a routine

Option Explicit

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
If hdlEditBox 0 Then Exit Function
hdlwndAct = GetActiveWindow()
hdlEditBox = FindWindowEx(hdlwndAct, 0, "Edit", "")
SendMessage hdlEditBox, EM_SETPASSWORDCHAR, Asc("*"), ByVal 0
End Function

Public Function InPutBoxPMasked(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

hdlEditBox = 0
Fgrndhdl = GetForegroundWindow
SetTimer Fgrndhdl, nIDE, 100, AddressOf TimerFunc

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

KillTimer Fgrndhdl, nIDE
InPutBoxPwd = sInput

End Function

Sub GetMaskedInput()
Dim x As String

x = InPutBoxMasked("Please enter text", "Get Masked Input")

If x = vbNullString Then
MsgBox "User Cancelled"
Else
MsgBox "User entered " & x
End If

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steph" wrote in message
...
Hello. Given the snippet of code below, is there a way to have the entry
into the InputBox show as *'s rather than what the user is actually
typing?
I know you can do that with a form, but not sure about an InputBox.
Thanks!


Rsp = InputBox("Enter the password to unprotect the worksheets")
If Rsp < Password Then
MsgBox "Incorrect password", vbOKOnly
Exit Sub
End If

Oops, typos


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
If hdlEditBox 0 Then Exit Function
hdlwndAct = GetActiveWindow()
hdlEditBox = FindWindowEx(hdlwndAct, 0, "Edit", "")
SendMessage hdlEditBox, EM_SETPASSWORDCHAR, Asc("*"), ByVal 0
End Function

Public Function InPutBoxMasked(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

hdlEditBox = 0
Fgrndhdl = GetForegroundWindow
SetTimer Fgrndhdl, nIDE, 100, AddressOf TimerFunc

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

KillTimer Fgrndhdl, nIDE
InPutBoxMasked = sInput

End Function

Sub GetMaskedInput()
Dim x As String

x = InPutBoxMasked("Please enter text", "Get Masked Input")

If x = vbNullString Then
MsgBox "User Cancelled"
Else
MsgBox "User entered " & x
End If

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Bob Phillips" wrote in message
...
Here is a routine

Option Explicit

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
If hdlEditBox 0 Then Exit Function
hdlwndAct = GetActiveWindow()
hdlEditBox = FindWindowEx(hdlwndAct, 0, "Edit", "")
SendMessage hdlEditBox, EM_SETPASSWORDCHAR, Asc("*"), ByVal 0
End Function

Public Function InPutBoxPMasked(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

hdlEditBox = 0
Fgrndhdl = GetForegroundWindow
SetTimer Fgrndhdl, nIDE, 100, AddressOf TimerFunc

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

KillTimer Fgrndhdl, nIDE
InPutBoxPwd = sInput

End Function

Sub GetMaskedInput()
Dim x As String

x = InPutBoxMasked("Please enter text", "Get Masked Input")

If x = vbNullString Then
MsgBox "User Cancelled"
Else
MsgBox "User entered " & x
End If

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steph" wrote in message
...
Hello. Given the snippet of code below, is there a way to have the
entry
into the InputBox show as *'s rather than what the user is actually
typing?
I know you can do that with a form, but not sure about an InputBox.
Thanks!


Rsp = InputBox("Enter the password to unprotect the worksheets")
If Rsp < Password Then
MsgBox "Incorrect password", vbOKOnly
Exit Sub
End If