Make this code run on 64-bit Excel?

[Sven62]

It's old code but I don't know or can't find any other way to mask password entry on an Input Box. This code runs fine at work with 32-bit Office. But my home computer kicks out a compile error. The only thing I can think of is the 32/64 thing. Am I wrong? Help?

The first code is the part that comes up colored red.

The second is the entire module in case that helps..

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

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
'// Works for Xl2000+ due the AddressOf Operator
'////////////////////////////////////////////////////////////////////




'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 = 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 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

 

[Jon Peltier]

Is this for a Textbox in a UserForm? In the VB Editor, open the UserForm and click on the Textbox. Scroll down the list of properties in the Property pane, and enter something applicable, like * for PasswordChar.

Much easier than juggling 32- and 64-bit calls to the Windows API.

 

[Sven62]

It is for an InputBox.

 

[Sven62]

It is to mask the password when running this macro. Is there a better way? How??

Sub UnprotectAllSheets()Dim N As Integer, pw As String


If InputBoxDK("Enter Password") <> "rabbit" Then
MsgBox ("Wrong Password, Check Caps Lock!")
Exit Sub
End If


Application.ScreenUpdating = False
For N = 1 To Worksheets.Count
Worksheets(N).Unprotect "rabbit"
Next N
ThisWorkbook.Unprotect "rabbit"
Application.ScreenUpdating = True
End Sub

 

[Sven62]

Here's the ANSWER! A userform with one text box and an "Enter" command button.

I should have learned this years ago....

Private Sub CommandButton1_Click()

Dim strPass As String

strPass = "rabbit"

If TextBox1.Value = strPass Then
    Call UnprotectAllSheets
    Unload Me
Else
    If MsgBox("The password was wrong, try again", vbYesNo) = vbNo Then
        Unload Me
    Else
        TextBox1.Value = ""
    End If
End If
End Sub