Password Protection for a portion of a database

[Monstermechanic]

I currently have a database which has been created to have a user interface which is seperate from the data. On the user interface is it possible to have a password on a button function. In otherwords when I activate one of the buttons I wish to have the user enter a password before the button completes its function and opens up a new wondow or form?

 

[dbDamo]

Yes - on the buttons on click event use the following code:-

  Dim pResponse As String
  Dim lSalesPersonID As Long
  Dim lEditHwnd As Long
  Dim lTemp As Long
  Dim sPwd As String
  gMsgTitle = "Security Check"
  gMsgType = vbOKOnly + vbInformation
  gMsgText = "Enter Password"
  Beep
  
  lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)
  sPwd = InputBox(gMsgText, gMsgTitle)
  MsgBox "the password you entered was: " & sPwd

    'Check to see if there is any entry made to input box, or if
    'cancel button is pressed. If no entry made then exit sub.
    If sPwd = "" Or sPwd = Empty Then
        MsgBox "No Input Provided", vbInformation, "Required Data"
        Exit Sub
    End If
 
 
    If sPwd = "YourPasswordHere" Then
 
[COLOR=red]'The rest of your code here[/COLOR]
 
Else
        MsgBox "Sorry, you do not have access to perform this operation", _
               vbOKOnly, "Important Information"
        Exit Sub
End If

You'll also need to paste this code into a new module - this masks the password:-

Option Compare Database
Option Explicit
   ' --- Global Constants (Messages) ------------------------------------
  Global gMsgText As String       'Text in MsgBox() and InputBox() functions
  Global gMsgType As Integer      'Type in MsgBox() and InputBox() functions
  Global gMsgTitle As String      'Title for MsgBox() and InputBox() function
  Global gStatusText As String    'Status bar text used in Application.Echo method
' API set A:
'  Used by the callback process (TimerProc) to hook into
'  the InputBox window
'  Ref: [URL]http://pub13.ezboard.com/fvisualbasicexplorervbtips.showMessage?topicID=314.topic[/URL]
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private 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 SetTimer& Lib "user32" _
(ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal _
lpTimerFunc&)

Public Declare Function KillTimer& Lib "user32" _
(ByVal hwnd&, ByVal nIDEvent&)
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
' Constants for API set A
Const EM_SETPASSWORDCHAR = &HCC
Public Const NV_INPUTBOX As Long = &H5000&
Public Function TimerProc(ByVal lHwnd&, ByVal uMsg&, _
ByVal lIDEvent&, ByVal lDWTime&) As Long
  Dim lTemp As Long
  ' This function allows for a mask character on an inputbox
  '    ' Usage (Replace anything between [] with valid names from your project):
  '  From a form or module:
  '  1. Declare a Long variable
  '  2. Call the timer function:  [variable] = SetTimer([form].Hwnd, NV_INPUTBOX, [elapsed time], AddressOf [function name])
  '  2b. Example usage from a form: lTemp = SetTimer(Me.Hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)
  '  3. Create your InputBox as usual
  
   Dim lEditHwnd As Long
  
  ' Find a handle to the InputBox window, then to the textbox
  ' the user types in (Known as "Edit")
  '    ' **This part is VERY important, here is how the FindWindowEx call should look:
  ' **Only change the parameters that are enclosed in [ ] in the following example
   lTemp = FindWindowEx(FindWindow("#32770", "[gMsgText]"), 0, "Edit", "")
   lEditHwnd = FindWindowEx(FindWindow("#32770", gMsgTitle), 0, "Edit", "")
  
  ' Send the mask character to the target InputBox when the user types
  ' The mask character in this sample is the Asc("*") - the "*" can be changed
  ' to whatever you like.
  
  Call SendMessage(lEditHwnd, EM_SETPASSWORDCHAR, Asc("#"), 0)
  ' Destroy the timer object when done (The user clicks OK or Cancel from the InputBox)
  KillTimer lHwnd, lIDEvent
End Function