Hi,
I know that this has been asked before but I want some code to create an inputbox in MS Access that has a password character * in it rather than displaying the text.
I know this is possible in MS Excel by creating a customer Inputbox in module code, however the Excel code does not work in MS Access.
Here is a sample of the Excel Code :
#~#~#~#~#~#~#~#~#~#~#~#~#~
#~#~#~#~#~
#~#~#~#~#~
#~#~#~#~#~
#~#~#~#~#~
#~#~#~
(basAddrOf) - Module
Option Explicit
'// My thanks to:
'// Ken Getz and Michael Kaplan
'// For their brilliant work with
'// Using Callbacks with Office 97
'// KNG Consulting, Inc.
'// Copyright © 1998
'// Ken Getz & Michael Kaplan
'// All rights reserved.
'-------------------------
----------
----------
----------
----------
----------
----------
----------
----------
----------
' Declarations
'
' These function names were puzzled out by using DUMPBIN /exports
' with VBA332.DLL and then puzzling out parameter names and types
' through a lot of trial and error and over 100 IPFs in MSACCESS.EXE
' and VBA332.DLL.
'
' These parameters may not be named properly but seem to be correct in
' light of the function names and what each parameter does.
'
' EbGetExecutingProj: Gives you a handle to the current VBA project
' TipGetFunctionId: Gives you a function ID given a function name
' TipGetLpfnOfFunctionId: Gives you a pointer a function given its function ID
'
'-------------------------
----------
----------
----------
----------
----------
----------
----------
----------
----------
Private Declare Function GetCurrentVbaProject _
Lib "vba332.dll" _
Alias "EbGetExecutingProj" ( _
hProject As Long) _
As Long
Private Declare Function GetFuncID _
Lib "vba332.dll" _
Alias "TipGetFunctionId" ( _
ByVal hProject As Long, _
ByVal strFunctionName As String, _
ByRef strFunctionId As String) _
As Long
Private Declare Function GetAddr _
Lib "vba332.dll" _
Alias "TipGetLpfnOfFunctionId" ( _
ByVal hProject As Long, _
ByVal strFunctionId As String, _
ByRef lpfn As Long) _
As Long
'-------------------------
----------
----------
----------
----------
----------
----------
----------
----------
----------
' AddrOf
'
' Returns a function pointer of a VBA public function given its name. This function
' gives similar functionality to VBA as VB5 has with the AddressOf param type.
'
' NOTE: This function only seems to work if the proc you are trying to get a pointer
' to is in the current project. This makes sense, since we are using a function
' named EbGetExecutingProj.
'-------------------------
----------
----------
----------
----------
----------
----------
----------
----------
----------
Public Function AddrOf(strFuncName As String) As Long
Dim hProject As Long
Dim lngResult As Long
Dim strID As String
Dim lpfn As Long
Dim strFuncNameUnicode As String
Const NO_ERROR = 0
' The function name must be in Unicode, so convert it.
strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
' Get the current VBA project
' The results of GetCurrentVBAProject seemed inconsistent, in our tests,
' so now we just check the project handle when the function returns.
Call GetCurrentVbaProject(hProj
ect)
' Make sure we got a project handle... we always should, but you never know!
If hProject <> 0 Then
' Get the VBA function ID (whatever that is!)
lngResult = GetFuncID( _
hProject, strFuncNameUnicode, strID)
' We have to check this because we GPF if we try to get a function pointer
' of a non-existent function.
If lngResult = NO_ERROR Then
' Get the function pointer.
lngResult = GetAddr(hProject, strID, lpfn)
If lngResult = NO_ERROR Then
AddrOf = lpfn
End If
End If
End If
End Function
#~#~#~#~#~#~#~#~#~#~#~#~#~
#~#~#~#~#~
#~#~#~#~#~
#~#~#~#~#~
#~#~#~#~#~
#~#~#~
(ModInput) - Module
Option Explicit
'/////////////////////////
//////////
//////////
//////////
//////////
///
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'
http://www.danielklann.com/
'March 2003
'// Kindly permitted to be amended
'// Amended by Ivan F Moala
'//
http://www.xcelfiles.com
'// April 2003
'// Amended for XL97
'/////////////////////////
//////////
//////////
//////////
//////////
///
'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
'// Make it public
'// Lets simulate the VBA Input Function
Public Function InputBoxDK(Prompt As String, Optional Title As String, _
Optional Default As String, _
Optional Xpos As Long, _
Optional Ypos As Long, _
Optional Helpfile As String, _
Optional Context As Long) As String
Dim lngModHwnd As Long, lngThreadID As Long
'// Lets handle any Errors JIC! due to HookProc> App hang!
On Error GoTo ExitProperly
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullStri
ng)
hHook = SetWindowsHookEx(WH_CBT, AddrOf("NewProc"), lngModHwnd, lngThreadID)
If Xpos Then
InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
Else
InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
End If
ExitProperly:
UnhookWindowsHookEx hHook
End Function
Sub TestDKInputBox()
Dim x
x = InputBoxDK("Type your password here.", "Password Required")
If x = "" Then End
If x <> "yourpassword" Then
MsgBox "You didn't enter a correct password."
End
End If
MsgBox "Welcome Creator!", vbExclamation
End Sub
#~#~#~#~#~#~#~#~#~#~#~#~#~
#~#~#~#~#~
#~#~#~#~#~
#~#~#~#~#~
#~#~#~#~#~
#~#~#~
You would then use InputBoxDK function as opposed to InputBox and this would * out the entered text as you enter it (just like a password character).
Can something simular be done with MS Access, as I don't want to have to create custom form, I want to just be able to use code to accomplish the relevant task.
Many thanks,
Gaz.