InputBox string password formatted
Bill Brinkworth
password protected (formatted) with the astericks (*********). I'm trying
to get a password before proceeding with a certain procedure. Here's a line
that I'm currently using:
strInput = InputBox(Prompt:=strMsg, Title:="Password")
When I used a pop-up box I was having a problem returning to the application
and proceding with the procedure.
Thanks for all your help!
Bill
Patrick Usher
Steve Fisher
You can't do this with an InputBox, but I think you were on the right track.
Create your own form with a text box for the password. Set the text box's
InputMask property to "Password".
To force your code to wait until the user has dismissed your form, use the
WindowMode argument:
DoCmd.OpenForm "frmLogin", WindowMode:=acDialog
The "acDialog" constant will open your form modally, and the code execution
won't continue until the form is closed or hidden.
On your password form, set the code for the OK button to hide the form
(don't close it). For the Cancel button, have code that closes the form.
After opening the form as shown above, the next line of code should check to
see whether the form is hidden (user pressed OK button) or closed (user
canceled). If form is hidden, validate the password or do whatever else you
need to do, then close the form. If you need code to check whether a form is
open, see the Northwind sample db.
HTH,
Steve Fisher
FMS, Inc.
Bill Brinkworth wrote in message ...
Terry Kreft
Heres some code which allows you to use a form as an Inputbox and allows you
to pass the InputMask you want to use.
The code is rather lengthy as if the form does not exist it will create a
basic version of the form.
'******** Code Start ***************
Option Compare Database
Option Explicit
'GetSystemMetrics Constants
Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17
'GetDeviceCaps Constants
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Const frmInputBox As String = "~frmInputBox~"
Private Const lngFrmWidth As Long = 4987
Private Const lngFrmHeight As Long = 2245
Function InputBox(Prompt As String, Optional Title As String = " ", _
Optional Default As String, Optional Xpos As Long = -1, _
Optional Ypos As Long = -1, Optional HelpFile As String, _
Optional Context As Long, Optional InputMask As String) As String
Dim strRet As String
Dim loform As Form
Dim ScreenDC As Long
If FormExists(frmInputBox) = False Then
Call MakeForm
End If
If Xpos = -1 Then
ScreenDC = CreateCompatibleDC(0&)
Xpos = GetDeviceCaps(ScreenDC, LOGPIXELSX)
Xpos = GetSystemMetrics(SM_CXFULLSCREEN) / Xpos
Xpos = Xpos * 1440
Xpos = (Xpos - lngFrmWidth) \ 2
End If
If Ypos = -1 Then
ScreenDC = CreateCompatibleDC(0&)
Ypos = GetDeviceCaps(ScreenDC, LOGPIXELSY)
Ypos = GetSystemMetrics(SM_CYFULLSCREEN) / Ypos
Ypos = Ypos * 1440
Ypos = (Ypos - lngFrmHeight) \ 3
End If
DoCmd.OpenForm frmInputBox, windowmode:=acHidden
Set loform = Forms(frmInputBox)
With loform
.CancelClose = True
.Prompt = Prompt
.Title = Title
.Default = Default
.Help_File = HelpFile
.Context = Context
.InputMask = InputMask
.Visible = True
.Xpos = Xpos
.Ypos = Ypos
Do While .Visible = True
DoEvents
Loop
strRet = .FormReturn
.CancelClose = False
End With
DoCmd.Close acForm, frmInputBox
InputBox = strRet
End Function
Private Function FormExists(FormName As String) As Boolean
Dim strSql As String
Dim loRst As Recordset
Dim loDb As Database
strSql = "SELECT Count(Name) AS CountOfName " _
& "FROM msysobjects WHERE (((Type)=-32768) " _
& "AND ((Name)='" & FormName & "'));"
Set loDb = CodeDb
Set loRst = loDb.OpenRecordset(strSql, dbOpenSnapshot)
FormExists = CBool(loRst!CountOfName)
End Function
Private Sub MakeForm()
Dim strName As String
Dim loform As Form
Dim loMdl As Module
Dim loTB As TextBox
Dim loLbl As Label
Dim loCmd As CommandButton
Set loform = CreateForm(CodeDb.Name)
strName = loform.Name
With loform
.Section(0).Height = lngFrmHeight
.Width = lngFrmWidth
.RecordSelectors = False
.NavigationButtons = False
.MinMaxButtons = 0
.BorderStyle = 3
.WhatsThisButton = True
.Caption = " "
.HasModule = True
.Modal = True
.PopUp = True
End With
Set loLbl = CreateControl(strName, acLabel, acDetail, , , 240, 225, 3357,
1531)
With loLbl
.Name = "lblPrompt"
.Caption = " "
End With
Set loTB = CreateControl(strName, acTextBox, acDetail, , , 240, 1965,
3357, 280)
loTB.Name = "txtReturn"
Set loCmd = CreateControl(strName, acCommandButton, acDetail, , , 3855,
225, 1132, 352)
With loCmd
.Name = "cmdOK"
.Caption = "OK"
.OnClick = "[Event Procedure]"
End With
Set loCmd = CreateControl(strName, acCommandButton, acDetail, , , 3855,
630, 1132, 352)
With loCmd
.Name = "cmdCancel"
.Caption = "Cancel"
.OnClick = "[Event Procedure]"
End With
Set loMdl = loform.Module
Call CreateFormMod(loMdl)
DoCmd.Close acForm, strName, acSaveYes
DoCmd.Rename frmInputBox, acForm, strName
End Sub
Private Sub CreateFormMod(loMdl As Module)
Dim intLines As Integer
Dim modArray(1 To 46) As String
Dim intX As Integer
Call FillArray(modArray())
intLines = loMdl.CountOfLines
For intX = 1 To 46
loMdl.InsertLines intLines + intX, modArray(intX)
Next
End Sub
Private Sub FillArray(modArray() As String)
modArray(1) = "Private strReturn As String"
modArray(2) = "Private blnCancelClose As Boolean"
modArray(3) = "Property Let CancelClose(NewClose As Boolean)"
modArray(4) = " blnCancelClose = NewClose"
modArray(5) = "End Property"
modArray(6) = "Property Get FormReturn() As String"
modArray(7) = " FormReturn = strReturn"
modArray(8) = "End Property"
modArray(9) = "Property Let Prompt(NewPrompt As String)"
modArray(10) = " Me!lblPrompt.Caption = NewPrompt"
modArray(11) = "End Property"
modArray(12) = "Property Let Title(NewTitle As String)"
modArray(13) = " Me.Caption = NewTitle"
modArray(14) = "End Property"
modArray(15) = "Property Let Default(NewDefault As String)"
modArray(16) = " Me!txtReturn = NewDefault"
modArray(17) = "End Property"
modArray(18) = "Property Let Xpos(NewX As Long)"
modArray(19) = " DoCmd.MoveSize Right:=NewX"
modArray(20) = "End Property"
modArray(21) = "Property Let Ypos(NewY As Long)"
modArray(22) = " DoCmd.MoveSize Down:=NewY"
modArray(23) = "End Property"
modArray(24) = "Property Let Help_File(NewHelp As String)"
modArray(25) = " Me.HelpFile = NewHelp"
modArray(26) = "End Property"
modArray(27) = "Property Let Context(NewContext As Long)"
modArray(28) = " Me.HelpContextId = NewContext"
modArray(29) = "End Property"
modArray(30) = "Property Let InputMask(NewInputMask As String)"
modArray(31) = " Me!txtReturn.InputMask = NewInputMask"
modArray(32) = "End Property"
modArray(33) = "Private Sub cmdCancel_Click()"
modArray(34) = " strReturn = """
modArray(35) = " On Error Resume Next"
modArray(36) = " DoCmd.Close acForm, Me.Name"
modArray(37) = "End Sub"
modArray(38) = "Private Sub cmdOK_Click()"
modArray(39) = " strReturn = txtReturn & """
modArray(40) = " On Error Resume Next"
modArray(41) = " DoCmd.Close acForm, Me.Name"
modArray(42) = "End Sub"
modArray(43) = "Private Sub Form_Unload(Cancel As Integer)"
modArray(44) = " Cancel = blnCancelClose"
modArray(45) = " Me.Visible = False"
modArray(46) = "End Sub"
End Sub
'******** Code End ***************
Terry Kreft
Sorry I've just realised there is a slight error in the code, please use
this instead.
Option Compare Database
Option Explicit
'GetSystemMetrics Constants
Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17
'GetDeviceCaps Constants
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Const frmInputBox As String = "~frmInputBox~"
Private Const lngFrmWidth As Long = 4987
Private Const lngFrmHeight As Long = 2245
Function InputBox(Prompt As String, Optional Title As String = " ", _
Optional Default As String, Optional Xpos As Long = -1, _
Optional Ypos As Long = -1, Optional HelpFile As String, _
Optional Context As Long, Optional InputMask As String) As String
Dim strRet As String
Dim loform As Form
Dim ScreenDC As Long
If FormExists(frmInputBox) = False Then
Call MakeForm
End If
If Xpos = -1 Then
ScreenDC = CreateCompatibleDC(0&)
Xpos = GetDeviceCaps(ScreenDC, LOGPIXELSX)
Call DeleteDC(ScreenDC)
Xpos = GetSystemMetrics(SM_CXFULLSCREEN) / Xpos
Xpos = Xpos * 1440
Xpos = (Xpos - lngFrmWidth) \ 2
End If
If Ypos = -1 Then
ScreenDC = CreateCompatibleDC(0&)
Ypos = GetDeviceCaps(ScreenDC, LOGPIXELSY)
Call DeleteDC(ScreenDC)
Dim lorst As Recordset
Dim lodb As Database
strSql = "SELECT Count(Name) AS CountOfName " _
& "FROM msysobjects WHERE (((Type)=-32768) " _
& "AND ((Name)='" & FormName & "'));"
Set lodb = CodeDb
Set lorst = lodb.OpenRecordset(strSql, dbOpenSnapshot)
FormExists = CBool(lorst!CountOfName)
End Function
Terry Kreft wrote in message ...
>Hi Bill,
>Heres some code which allows you to use a form as an Inputbox and allows
you
>to pass the InputMask you want to use.
<Clip>