Can I create a sort of "Anti Tamper" macro?

[tonywatsonhelp]

Hi Everyone,
I have a document thats going to go out to over 200 people.
I have set it up with loads of macros stopping anyone from editing, changing and playing around with it, however there is still the possability that someone might think they know what they are doing and change things as password protection is easily cracked.

so as one last part of security I'd like to check when the document is opened that everthing is how it should be.
So heres what i was thinking.

have a macro that when the document opens checks the tab names,
I have a sheet called "control" in column Z I could list all the tabs in the document by Name,
The macro could then go in and check if any sheets exist that have a different name to this one,
Maybe we could also check the document name is the same as Control A7?

then if any of these errors exist I'd like a message box to pop up saying This document apears to have been tampered with and can no longer be used, please speak with you IT department to have this fixed!
and close the document down.

I know there will always be ways around this, but I think it would help stop the problem.

So if anyone know the macro to do this that would be great.

thanks

Tony

 

[mumps]

Try this in the code module for ThisWorkbook:

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, ws As Worksheet, shName As Range, rng As Range
    Set srcWS = Sheets("Control")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each ws In Sheets
        Set shName = srcWS.Range("Z:Z").Find(ws.Name, LookIn:=xlValues, lookat:=xlWhole)
        If shName Is Nothing Then
            MsgBox ("This document apears to have been tampered with and can no longer be used, please speak with you IT department to have this fixed!")
            ActiveWorkbook.Close False
        End If
    Next ws
    For Each rng In srcWS.Range("Z1:Z" & LastRow)
        If Not WorksheetExists(rng.Value) Then
            MsgBox ("This document apears to have been tampered with and can no longer be used, please speak with you IT department to have this fixed!")
            ActiveWorkbook.Close False
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Function WorksheetExists(WSName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Worksheets(WSName).Name = WSName
    On Error GoTo 0
End Function

It assumes that the sheet names begin in row 1 of column Z. Don't forget to add "Control" to the list in column Z. It also checks if a sheet has been deleted.

 

[tonywatsonhelp]

Mumps,
This is perfect, I tested a few things and works great,
thank you so much for your help

Tony

 

[mumps]

You are very welcome. I would suggest that even though protection isn't that "sturdy", you use it as well. Also prevent the macros from being visible.
To protect your macros, you have to protect your VBA Project. Do the following:
-hold down the ALT key and press the F11 key to open the Visual Basic Editor
-click on 'Tools' on the top menu
-click 'VBAProject Properties'
-click the 'Protection' tab
-click the box to the left of 'Lock project for viewing' to put a check mark in it
-enter your password and then confirm it and click 'OK'
-close the VB Editor
-save your file
When you re-open the file, you will not be able to see the macros unless you enter the password. Keep in mind that this type of protection is not very strong and anyone who really wants to get at your macros can probably do it with a little research. I hope this helps.