Prevent Sharing & Issue With Expiration VBA

[mrfahaji]

I have created an excel-based game that I plan to distribute. However, I don’t want people to be able to then share it freely with others, so I am looking for ways to protect the document. A password could work but I figure that people could just share the password along with the file, so I started looking at an expiry date.

Within the ThisWorkbook module, I have added the following

Dim exp_date As Date
exp_date = "16/07/2023" 'update this'
If Date > exp_date Then
MsgBox ("Worksheet expired. Please contact creator to renew access")
ActiveWorkbook.Close


But even though it works to an extent, I’ve noticed that you can close the message box and then when you get the save prompt on closing, simply click ‘Cancel’ and you can carry on accessing the workbook as usual. How can I prevent this?

I have considered adding a ‘clear’ command within the expiry macro, but I worry that such a command would ruin the document for anyone who goes back to play after some time away. Perhaps there is an option to get a reactivation code that would postpone the expiry date.

Is there any way to prevent this? Or any other suggestions for how to effectively protect the file against mass sharing/distribution would be very welcome! I know that the VBA approach can be circumvented quite easily, but it would be better than nothing. In some similar threads, and it looks like the XLS Padlock software might be my best solution, but it is pretty expensive!

 

[elynoy]

You could lock the file to username of the PC, MAC address, hard drive, etc.

It gets the info on first opening and saves it. if it's opened in another PC you can set it o delete itself for example.

 

[mrfahaji]

You could lock the file to username of the PC, MAC address, hard drive, etc.

It gets the info on first opening and saves it. if it's opened in another PC you can set it o delete itself for example.

This sounds promising, thanks for the suggestion. Is that VBA?

Presumably though, if I sent it to Person A, they could just save their own copy and then forward the email to Person B? That wouldn't prevent it?

 

[elynoy]

Yes, it's VBA, I have the code for it somewhere, I'll update the topic when I get home so you can check it out unless someone else answers it first.

And it the email is forwaded it shuld allow the person recieving it and open it. but on thet first open it gets the info of the PC, and if it doesnt match the info, like I said, you can set it to delete the file, or just close it for exemple.

I forgot to mention. There's a possibility of you setting 2 files.
You send the file 1 to person A, that person A opens the file and it fetches the info needed.
Person A sends the info to you.
You populate the GAME FILE with the info Person A sent you.

That way you block the file you send already at the start (so to speak). This way even if Person A forwards the email, it should block the usage since the info provided belong to person A and not anyone else.

Keep in mind that excel might be secure to some point but if someone really wants to see what you have.. there's always a way. Don't think it's 100% secure.

 

[elynoy]

File 1 - To get the info needed aka Serial Number of the C drive on the target computer. (and some exgtra code like hide the unused sheets. you can keep only the part where it gets the code if you want. I used it like this to keep it "neat".

Place this on VBA "Thiswoorkbook".

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
'Step 1:  Declare your variables
    Dim ws As Worksheet

'Step 2: Unhide the Starting Sheet
    Sheets("START").Visible = xlSheetVisible

'Step 3: Start looping through all worksheets
    For Each ws In ThisWorkbook.Worksheets
 
'Step 4: Check each worksheet name
    If ws.Name <> "START" Then
 
'Step 5: Hide the sheet
    ws.Visible = xlVeryHidden
    End If
 
'Step 6:  Loop to next worksheet
    Next ws

'Step 7:  Save the workbook
    ActiveWorkbook.Save

End Sub

Private Sub Workbook_Open()
'Step 1:  Declare your variables
    Dim ws As Worksheet

'Step 2: Start looping through all worksheets
    For Each ws In ThisWorkbook.Worksheets
 
'Step 3: Unhide All Worksheets
    ws.Visible = xlSheetVisible

'Step 5:  Loop to next worksheet
    Next ws

'Step 6:  Hide the Start Sheet
    Sheets("START").Visible = xlVeryHidden
    Application.WindowState = xlMaximized
 
End Sub
 
'This is the code where you get the drive C serial number to use in the code below on file 2 code part.
'Change "E4" to whatever cell you want it to display the serial number.
 
Sub DriveSerialNumber()
   Range("E4").Value = CreateObject("Scripting.FileSystemObject").GetDrive("C:\").SerialNumber
 
End Sub

Sheet 2 - Game File
Place this code on VBA "Thiswoorkbook".

Private Sub Workbook_Open()

'This code is to Test PC serilNo

    Dim oFSO As Object

    Dim drive As Object


    Set oFSO = CreateObject("Scripting.FileSystemObject")

    Set drive = oFSO.GetDrive("C")


    '*This line to check Drive SerialNumber

'that code "-766189349" is the code you need to replace with the code of the person you want to give the game. So it means you need to create a file and 'send that file to someone and then that someone needs to send you back the serial generated by that code.


If drive.SerialNumber <> -766189349 Then Application.Run "KillThefit"

 

    '*release memory

    Set oFSO = Nothing

    Set drive = Nothing


End Sub

Now you need to create a module on the Game File and place this code:

Private Sub KillThefit()

     '*This code is to prevent illegal copying

MsgBox "Copy not authorized. ", vbExclamation + vbMsgBoxRight

 


'Remove the  '  below and it will execute the code. You can leave it like this to test and when done testing uncomment the code below to make it work as 'intended.

' You can play with the lines too, if you uncomment everytthing it will close and delete. You can only choose to close it  or not. Make copy of it and play 'around, get used to it.

 

    Application.DisplayAlerts = False

    ThisWorkbook.ChangeFileAccess xlReadOnly

    'Kill ThisWorkbook.FullName

    ThisWorkbook.Close True

    Application.DisplayAlerts = False

 

End Sub

Keep in mind that this code is not mine. I got this form somewhere too and it worked fine for my needs at the time.

hope this helps

best regards

 

[johnnyL]

@elynoy Do you have a sample file that you can provide a link to that uses this approach and 'theoretically' would not allow us to use the file without the correct PC, MAC address, hard drive, etc. ?

I am asking because, I am not convinced.

Edit: Please do not provide any file that you wouldn't want leaked, as the OP's intention was. Any simple file would suffice.

 

[johnnyL]

Nevermind, I tested it myself & as I suspected, the code is pretty much useless.

 

[elynoy]

Well, i said its not 100 secure.. But works to some point.

Joweber to sau its useless i wouldnt say that either.. Protect vba with a ow, thw code as well.. Hide the sheets.. Tou can tweek it loke i did..

But if tou have a better approach id love to know it too..

 

[elynoy]

Sorry the double post.

I have more code in the files of corse and one is to force to save as xlsm so the file cant be saved as other format. Like i said, tweek it to your needs, play with it to what suits you best.

Amd like i said already, its still away from beeing secure. But its excel..


Either way, it was usefull to me, to my needs like i said.

 

[mrfahaji]

Sorry for the lack of reply from me. I appreciate elynoy's efforts in offering a solution and I understand the principle of having the two files - it's a smart idea but also a bit clunky for a situation where I might be sending it out to a few people at once.

I was thinking I could encrypt the files, with each file I send out having a different password - this wouldn't prevent sharing but done in such a way it could reduce it.

The main question I have, referring back to my original post, is how to make the expiration code a little harder to bypass. I accept that someone with good excel skills could figure a way to 'break' the code, but I was able to get around it simply by clicking 'cancel' on the save box after I got the message, which renders the code pretty much useless!