Excel Worksheet Security

  dogbreath1 19:29 30 Aug 2010

How can I restrict the use of an Excel worksheet to one computer?

I believe that macros can be used to ID the serial number of a PC's hard drive and that an algorithm can be used to generate an activation code which would prevent migration.

If it is possible (by any method), I would appreciate advice on how to achieve this.

  VoG II 20:01 30 Aug 2010

That is actually incredibly difficult to do.

Would validation using the user's Windows logon name be an option?

If you are trying to create a secure environment in Excel then forget it - Excel security is pants. Anubvody can crack it.

  dogbreath1 20:44 30 Aug 2010

I created what I believe to be a useful worksheet to assist a particular profession. I want to marhet this and to make it as difficult as possible to migrate the sheet from PC to PC.

I'd consider any way of assisting in this objective.

  dogbreath1 20:45 30 Aug 2010

...market, even!

  dogbreath1 16:24 14 Sep 2010

Have now got the following code to force a workbook user to enable macros. This works fine and is situated in 'ThisWorkbook'.

Option Explicit

Const WelcomePage = "Macros"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If

'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = True
Application.EnableEvents = True
.Close savechanges:=False
Application.EnableEvents = True
End If
End With
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI)
Cancel = True

'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True
End Sub

Private Sub Workbook_Open()
'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
End Sub

Private Sub CustomSave(Optional SaveAs As Boolean)
Dim ws As Worksheet, aWs As Worksheet, newFname As String
'Turn off screen flashing
Application.ScreenUpdating = False

'Record active worksheet
Set aWs = ActiveSheet

'Hide all sheets
Call HideAllSheets

'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
End If

'Restore file to where user was
Call ShowAllSheets

'Restore screen updates
Application.ScreenUpdating = True
End Sub

Private Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet

Worksheets(WelcomePage).Visible = xlSheetVisible

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws

End Sub

Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page

Dim ws As Worksheet

ThisWorkbook.Sheets("Sheet1").Visible = xlSheetVisible

Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub

....see next post....

  dogbreath1 16:24 14 Sep 2010

However, picked up another couple of pieces of code which are supposed to 'read' the computer name and only open the workbook (at sheet1) if that name matches one previously embedded in the second piece of code. I cannot get these to work. Not even sure of the best place to site the code.

The first piece is:-

Option Explicit
Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

Function ReturnComputerName() As String
Dim rString As String * 255, sLen As Long, tString As String

tString = ""
On Error Resume Next
sLen = GetComputerName(rString, 255)
sLen = InStr(1, rString, Chr(0))
If sLen > 0 Then
tString = Left(rString, sLen - 1)
tString = rString
End If
On Error GoTo 0
ReturnComputerName = UCase(Trim(tString))

End Function

The second piece containing the name (here shown as ALAN), is as follows:-

Private Sub Workbook_Open()

'Check if running on ALAN
If ReturnComputerName = "ALAN" Then
'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
'User is not ALAN
Application.DisplayAlerts = False
End If

End Sub

My objective is to get all of this code working on one workbook, to enforce macros to be enabled and then to ensure that the user is authorised to open the workbook.

Help needed, please.

  Belatucadrus 23:49 14 Sep 2010

click here Office Security OwnerGuard claims it can lock excel documents to specific computers and there's a free personal use version you could try.

  Forum Editor 00:16 15 Sep 2010

Forget about distributing a workbook that can't be copied.

  dogbreath1 10:07 15 Sep 2010

Will check that out, thanks.

  dogbreath1 10:14 15 Sep 2010

I've accepted from an early point that I cannot expect to 'adequately' secure an Excel workbook. I'd be happy just to prevent casual copying and distribution.

Using macros to attempt the following:-

1. Force enable macros
2. Limit workbook access to one user

...is what I had resigned myself to achieving.

  jonmac 20:23 30 Jan 2011

Just how secure is an Excel file protected by a 4 digit number? I store various passwords in one in the form of hints to them which only I would know the answer to e.g. name of first dog/camera/ girlfriend etc.

So far so good but I'm not sure how easy it would be for someone to crack the access number. Anyone help?

This thread is now locked and can not be replied to.

Elsewhere on IDG sites

Xiaomi Mi Mix 2 review

See mcbess's iconic style animated for Mercedes-Benz

iPhone X news: Release date, price, new features & specs

Black Friday 2017 : date, sites participants & bonnes affaires