Restrict Excel Functionality Company-wide

[Hap]

Is it possible using an Excel add-in to force all new spreadsheets to only be visible or functional if opened on a company computer containing the company add-in? I am looking for a security method that would prevent company documents from being able to be run or used on a computer outside the office. The goal is to prevent or minimize the ability of exiting employees to effectively steal spreadsheet tools. I would like to have it not affect daily use of excel but be more passive security.

 

[Jon Peltier]

ALL new workbooks, or just special company-related workbooks and templates? Blocking all new workbooks seems a bit draconian, and won't help if someone emails a file outside of the company..

I would put something into the Workbook_Open event procedure of the company files that detects whatever is special about a company computer, and if that is not present, closes the file right away.

 

[Hap]

The intent isn't to prevent usage of Excel at all. All workbooks generated in the office are company-related workbooks.

Adding something to a Workbook_Open would require forcing all new workbooks to a macro-enabled file type. Is it possible to restrict new workbooks to an office standard template? As far as what is detected I was thinking more along the lines of detecting a file on the company server. If the file is not located then close the workbook. I'm not stuck on forcing all new workbooks to this but I would certainly want to do this for a number of existing special company tools. The other downside would be what happens if the server file is moved, deleted, or the server is down? What about using an Add-in? Would it work to retrieve an approval from a function in an Add-in? If the function is missing then close the file?

 

[Jon Peltier]

You would need the company files to always be saved in an unusable, secure state (all useful sheets very hidden, only one dummy sheet visible, password protected, etc.). This is usually accomplished using code in each workbook itself, and I'd think it's less reliable in an add-in, but it could work. The add-in would open the file, then make it usable (display the sheets and hide the dummy sheet). Then on every save, it would secure the file, save it, then unsecure it for further use.

You can set up company computers so by default it creates workbook s based on a special template, but it isn't hard to get around, even unintentionally.

Your file could retrieve the value of a function that resides in the add-in, but if the add-in is not present, the file itself would need code to shut down. And you didn't want macro-enabled files. So you're back to an add-in that stores files in a secure state.

 

[mole999]

This is now redundant, but something I used to use to check on files

Option Explicit
Const XXX = "Pro_Omega.xls"

Sub externalkey()

'Check Path
    If FileExists("X:\Resource Centres\OMEGA_Vehicle_Key_Master.xls") Then GetLatestVersionID 'working
        'Get Current Value
    If FileExists("X:\Resource Centres\OMEGA_Vehicle_Key_Master.xls") Then
    Range("K1").Select
    ActiveCell.Value = "Main"
    Range("L1").Select
    Selection.NumberFormat = "0.00"
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-1],'X:\Resource Centres\[OMEGA_Vehicle_Key_Master.xls]VehicleKeyMain'!R1C9:R1C10,2,0)"
        Range("j5").Select
    End If
    
    'Compare Values & Update Message
    If Range("L1").Value > Range("G1").Value Then message
    'Import New data
    
    'IsVehicleKeyAvailable
    
 
    
    '*****************************
    'look for updated vehicle key
    
End Sub
Sub message()
Select Case MsgBox("A New version of the Vehicle Key now exists" _
                   & vbCrLf & "You should allow this update to run" _
                   & vbCrLf & "" _
                   & vbCrLf & "INSTALL AT THIS TIME ?" _
                   , vbYesNo Or vbQuestion Or vbSystemModal Or vbMsgBoxRtlReading Or vbDefaultButton1, "Vehicle Key")
'Keys are reversed Yes / No

    Case vbYes
    ' copy the new data over the old data
    copynewtoold
    updateversionnumber
    Case vbNo
End Select
End Sub
Public Sub GetLatestVersionID()
'not used, step over
'Dim getvalue As array
'Dim P, F, S, A, KeyA
 ' P = "X:\Resource Centres"
 ' F = "OMEGA_Vehicle_Key_Master.xls"
 ' S = "VehicleKey"
 ' A = "J1"
'KeyA = getvalue(P, F, S, A)
End Sub
Public Sub copynewtoold()
Dim fPath, fName, sName, sName2, CellRange As String
 Workbooks(XXX).Worksheets("VehicleKey").Visible = True
'fPath = "C:\Users\xxxx\Desktop"
fPath = "X:\Resource Centres"
fName = "OMEGA_Vehicle_Key_Master.xls"
sName = "VehicleKeyMain" 'from worksheet named
sName2 = "VehicleKey" 'to worksheet named
CellRange = "A2:I10000"
Application.DisplayAlerts = False
Workbooks.Open fPath & "\" & fName
'Workbooks.Open "C:\Users\xxxx\Desktop\OMEGA_Vehicle_Key_Master.xls"
Worksheets(sName).Range(CellRange).Copy
ActiveWorkbook.Close
Worksheets(sName2).Range(CellRange).PasteSpecial
Workbooks(XXX).Worksheets("VehicleKey").Visible = False
Application.DisplayAlerts = True
ThisWorkbook.Save
'MsgBox "Vehicle Key Updated"
End Sub
Public Sub updateversionnumber()
'On Error Resume Next
'New Value to Master Key
Dim marker As String
Sheets("VehicleKey").Visible = True
    Sheets("WestCover").Select
    Range("L1").Select
    Selection.Copy
    marker = Range("L1")
    Sheets("VehicleKey").Select
    Range("J1").Select
    Range("J1") = marker
    'ActiveCell.FormulaR1C1 = "=WestCover!RC[-3]"
     '   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Range("J2").Select
ActiveWindow.SelectedSheets.Visible = False
'Workbooks(XXX).Worksheets("WestCover").Select
 '   Range("G1").Select
  '  ActiveCell.FormulaR1C1 = "=VehicleKey!RC[3]"
   ' Range("G1").Select
   ' Selection.Copy
   ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'New Value to Display
Workbooks(XXX).Worksheets("WestCover").Select
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "=VehicleKey!RC[3]"
    Range("G1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
End Sub

 

[Hap]

Thank you Jon!! I appreciate the feedback.

Mole999 that is an interesting check. Thank you for the input.