Create a VBA password

dannyt1251

New Member
Joined
Oct 20, 2006
Messages
2
Please help:

I would like a simple piece of VBA code that locks the user out of excel after a set amount of time (lets say 15 minutes) and requires a password to get back in.

Also, I know there is a formula to create unique numbers in cells (i.e: 1 in cell D3, 2 in cell D4 ETC.) I seem to remember the word 'autonumber' but I can't get a formula to work, and I can't find it in the insert function. Any ideas please?
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

GlennUK

Well-known Member
Joined
Jul 8, 2002
Messages
11,547
What criteria should trigger the macro? 15 minutes of inactivity, or is it just 15 minutes after opening a particular workbook? Do you really mean locked out of Excel, or do you mean locked out of a particular workbook?

As for 'autonumber', there is no such thing in Excel, but have a look here:
http://www.mrexcel.com/archive/Formulas/8089.html
 

dannyt1251

New Member
Joined
Oct 20, 2006
Messages
2
15 minutes of inactivity would be ideal, if it's possible. What I'm making is a class register and in order to comply with the data protection act this password thing would be ideal if someone scatterbrained forgets to close it down.

It's for A-level coursework but I'm not very good with VBA, so lock it out of the workbook if it's simpler
 

GlennUK

Well-known Member
Joined
Jul 8, 2002
Messages
11,547
Put a password on the workbook.

Set up a Public variable to hold the latest activity time, or even use a cell on one of the sheets for this, and have it update every time there is a Worksheet_SelectionChange or Worksheet_Activate event, updated with the time of the event.

On opening the book set the lastest activity time, do a OnTime to check the book every 2 minutes, and check the current time against the time stored, and if more than 15 minutes then save and close the book.
 

baxio

New Member
Joined
Apr 1, 2006
Messages
4

ADVERTISEMENT

I'm sorry but that makes no sense to me.

I've saved the file with a password, and I understand I need to make a code in visual basic editor, but what do I click on to insert the code into? The "This workbook" directory?

And can you write the code for me, because I'm sorry but I'm no good with VBA and this makes no sense. I'm going mad here!
 

ktab

Well-known Member
Joined
Apr 21, 2005
Messages
1,297
Try this:
Code:
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
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
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, RetVal) = "#32770" Then
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
End If
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
Sub PassWord()
Dim message1, title1, default1, myGetUserPW1, thePW
thePW = "1" 'place your password here
message1 = "Enter your password:"
title1 = "This is a Password Protected Application!"
default1 = ""
1 If MsgBox("Required password to continue", vbOKOnly) = vbOK Then
    myGetUserPW1 = InputBoxDK(message1, title1, default1)
    If myGetUserPW1 = thePW Then
        GoTo myend
    Else
        GoTo 1
    End If
End If
myend:
Application.OnTime Now + TimeValue("00:15:00"), "password"
End Sub

The functions and the general idea of passwordchar inputbox was given to me also but i cannot recall right now (sorry author :( ).

The sub password is the one that will make password request to be made each 15 minutes. If you paste code to workbook open event you've got your solution. (like:)
Code:
Private Sub Workbook_Open()
Application.Run "PassWord"
End Sub
 

Cbrine

Well-known Member
Joined
Dec 2, 2003
Messages
3,196

ADVERTISEMENT

Just a general comment on this. Excel is NOT a secure environment, and I can tell about 10-15%(if not more) of the board members here could easily bypass this "security" that you are using. So if you are looking to keep casual users out, then go for it, if you are looking for real security, look at a totally different application.

My 2 cents.

HTH
Cal
 

ktab

Well-known Member
Joined
Apr 21, 2005
Messages
1,297
Regarding me, I surely know that, not only VBA password protection, but also password protection of application itself. (VBA a simple ctr+break would do the job). It's just for keeping "casual" users off.
 

Cbrine

Well-known Member
Joined
Dec 2, 2003
Messages
3,196
ktab,
No worries, it was mostly for the OP. I would figure if you are at the API usage level, you would have cracked a few passwords or at least seen code that would do so. It's also pretty easy to bypass the vbe password's.

Cal
 

Forum statistics

Threads
1,136,515
Messages
5,676,302
Members
419,619
Latest member
jalme

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top