VBA How to force a function to return when a form button is clicked

Question

I thought it would be simple, but it is rather difficult. Any tips or ideas will be considered.

I have a form in Excel that, if a specific button is clicked, I need the user to enter a password before the code for that button will be launched.

I could just use the input field, but this will allow anyone else to see the password as I type. So I want to use the second form with a text box and set the PasswordChar parameter to *

Here is the problem. I want to use code like this

if checkPassword("Please enter your password") = False then exit sub

checkPasswordis a function that takes a string as a parameter. This function opens the form and places the message in the layout. The user must enter a password and click "OK."

sub btnOK_Click()must verify the password is correct, and then force the function that opened the form to be forced to return True if the password was ok or False - the password is incorrect.

I just can't figure out how to make the function return. I tried setting the global variable to both True and False when the user clicks OK and then uploads the form. This forces the function to return, but also resets all global variables specified by the form.

Here is my function that calls the form

Function checkPassword(message As String) As Boolean

  frmPassword.Show
  frmPassword.passwordMsg.Caption = message

  'passwordStatus is a global variable
  If passwordStatus = True Then checkPassword = True Else  checkPassword = False

End Function

Here is the link associated with the OK form:

Private Sub passwordok_Click()

  If Me.passwordtext.Text = "password" Then
      passwordStatus = True
  Else
      passwordStatus = False
  End If
  Unload Me

End Sub

Answer 1

Returning a value from a dialog is a common task and fairly simple to do.

, , .

Private passwordStatus As Boolean

Function checkPassword(message As String) As Boolean
  '//setup the form
  Me.passwordMsg.Caption = message

  '//show the form modally, this will not return until the form is unloaded 
  '//i.e. when the button is clicked; so values in private variable are still valid
  Me.Show vbModal

  '//form is unloaded (via unload me or a close) return the value;
  checkPassword = passwordStatus
End Function

Private Sub passwordok_Click()
  passwordStatus = Me.passwordtext.Text = "password"
  Unload Me
End Sub

passworkOk = frmPassword.checkPassword("enter your blabla")

Answer 2

  

, - . PasswordChar *

  

- .

: , ,

Private Sub passwordok_Click()
    Dim Prompt, password As String
    Prompt = "Please enter your password."
    password = InputBoxDK(Prompt)

    MsgBox password '<~~ Do whatever you want to do with this
End Sub

Option Explicit

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

    'A window has been activated
    If lngCode = HCBT_ACTIVATE Then
        RetVal = GetClassName(wParam, strClassName, lngBuffer)
        'Class name of the Inputbox
        If Left$(strClassName, RetVal) = "#32770" Then
            '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

Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) As String
    Dim lngModHwnd As Long, lngThreadID As Long
    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
    UnhookWindowsHookEx hHook
End Function