Thread: Problems with inputbox

Hi Guys,

On my workbook i have a sheet hidden using xlVeryHidden and im wanting to have a button that when clicked asks the user for a password. When the password is correct it should show a msgbox stating 'password correct', if password incorrect it show show a msgbox stating 'Password Incorrect'. This i can do. the problem i am having is using the cancel button on the input box without getting the msgbox stating 'Password Incorrect' - ANY IDEAS?

will im here is there a way to change the inputbox from showing the characters entered but show ************* instead?

Thanks,

Si

The easiest way is to create a UserForm, but this code uses an InputBox

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

    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 = avail to ALL Modules
'// 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(vbNullString)

    hHook = SetWindowsHookEx(WH_CBT, AddressOf 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 test()
    Dim PW As String
    PW = InputBoxDK("Please enter the password.", "Password Required")
    If PW <> "THEPASSWORD" Then
        MsgBox "That's not correct"
        Exit Sub
    End If
End Sub

What do you want it to do?

maybe

Sub test()
    Dim PW As String
    Const PWOK As String = "THEPASSWORD"
    PW = InputBoxDK("Please enter the password.", "Password Required")

    Select Case PW
    Case vbNullString
    MsgBox "User cancelled"
    'close workbook, no save
    ThisWorkbook.Close False
    Case Is <> PWOK: MsgBox "That's not correct"
    'try again, this will loop until pw is correct
    test
    Case Else: MsgBox "Password OK"
    End Select
End Sub

If you are satisfied with the solution(s) provided, please mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save