Preventing workbook use on another computer

[jmjj215]

I need to prevent a workbook from being used on multiple computers (can copy it to heart's content, just can't use it on multi comps).

I was thinking of some code on opening the workbook that would (on the first open on that machine) retrieve something unique to that machine (a MAC address maybe?, but something less interchangeable would be better) which would be stored in the file. The next time it would be opened it would simply check against what is stored and what is on the machine - if they weren't compatible it would exit the program.

Is this possible? Plausible? I know someone could easily bypass the opening macro with the shift key so I might put it somewhere else in the workbook also.

 

[Dreamboat]

Why not just save it as read-only? That forces them to copy it.

Anne Troy
Killer Coder Live Chat!

http://www.vbaexpress.com/forum/showthread.php?p=2121

 

[jmjj215]

They have to be able to make changes to the file. Each user purchases their own copy and I'm trying to prevent users from purchasing one copy and distributing it to their friends.

 

[Dreamboat]

Impossible, really, without a serial number registration and installation of the file....I take it you mean like an Excel file that you sell.

The only real way to enforce anything is to create a VB app for it.

Anne Troy
Killer Coder Live Chat!

http://www.vbaexpress.com/forum/showthread.php?p=2121

 

[byundt]

You can keep honest people honest, but a determined person can circumvent any security you place on Excel workbooks. John Walkenbach discusses some of the issues at:

http://j-walk.com/ss/excel/tips/tip100.htm

You may wish to store a serial number in one of several places:
Registry:

http://j-walk.com/ss/excel/tips/tip60.htm

Named constant in workbook (especially a hidden one):

http://j-walk.com/ss/excel/tips/tip26.htm

and

http://j-walk.com/ss/excel/tips/tip58.htm

Document properties:

http://www.cpearson.com/excel/docprop.htm

Hidden name space:

http://www.cpearson.com/excel/hidden.htm

Although it is obvious to a skilled user, you can hide a serial number in the registry, then compare it to a value in the workbook. If they match, then the worksheets can be displayed. If not, then all you see is a splash screen.

Here is some code that might be used for that purpose:

Public wbClosing As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
wbClosing = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
SpecialSave
Cancel = True
End Sub

Function SerialNumberChecker() As Boolean
Dim SerialNum As String
Dim KeyNum As Variant
On Error Resume Next
SerialNum = [=SerialNum]    'You may want to pick a less obvious name than SerialNum
SerialNum = thisdocument.custombuiltinproperties
If SerialNum = "" Then
    SerialNum = "A" & Format(Now, "#.000000")
    ThisWorkbook.Names.Add _
        Name:="SerialNum", RefersTo:="=" & Chr(34) & SerialNum & Chr(34), Visible:=True
    SaveSetting "MyApp", "Startup", "Top", SerialNum
    SerialNumberChecker = True
Else
    KeyNum = GetSetting(appname:="MyApp", section:="Startup", key:="Top")
    If CStr(KeyNum) = SerialNum Then SerialNumberChecker = True
End If
End Function

Private Sub SpecialSave()
Dim ws As Worksheet, wsSplash As Worksheet, wsCurrent As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wsSplash = Worksheets("Splash screen")
Set wsCurrent = ActiveSheet
wsSplash.Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Splash screen" Then ws.Visible = xlSheetVeryHidden
Next ws
ThisWorkbook.Save
If wbClosing = True Then ThisWorkbook.Close
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Splash screen" Then ws.Visible = xlSheetVisible
Next ws
wsSplash.Visible = xlSheetVeryHidden
wsCurrent.Activate
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Private Sub Workbook_Open()
Dim ws As Worksheet, wsSplash As Worksheet
If Not SerialNumberChecker Then Exit Sub    'Requires a valid serial number in registry
Application.ScreenUpdating = False
wbClosing = False
Set wsSplash = Worksheets("Splash screen")
wsSplash.Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Splash screen" Then ws.Visible = xlSheetVisible
Next ws
wsSplash.Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
End Sub