How to hardware lock an Excel workbook

[Dom2012]

Does anyone know of a way to do this. There are programs that encrypt and lock Excel - DoneEx and ExcelShield - but DoneEx has technical problems and ExcelShield has terrible customer relations. Does anyone know of another product of a formula or othersystem to achieve hardware locking and security?

Thanks,

 

[SydneyGeek]

Have you done a Google search to see what comes up?

Denis

 

[Dom2012]

Yep. So far nothing. But it took me quite a while just to find DoneEx and ExcelShield, so there could very well be other methods and I'm just not finding them. Wold you mind having a go? Maybe you'll be more lucky.

Thanks,
Dom

 

[SydneyGeek]

Hi Dom,

Don't know how they stack up but check this site -- http://www.ionworx.com/SerialShield.html

Denis

 

[Andy128]

What is wrong with Excel's built in password / encryption of workbook?

Tools>Options>Security password>advanced- choose encryption

Is it too basic?

Andy (newbie)

 

[Dom2012]

It's far too basic. I need something that is, by realistic definition, unhackable.

 

[Hatcheda]

edit as needed
MAKE a BACKUP!! -or two

Then try this:

Option Explicit

Dim shiftVal() As Integer

Public Sub Decode()
    Dim ans As String, i As Integer, j As Integer, ctr As Integer
    Dim cl As Range
    
    On Error GoTo escape
    
    'determine encoding values
    ans = InputBox("Hi")
    ReDim shiftVal(1 To 100 * Len(ans))
    ctr = 0
    For i = 1 To 100
        For j = 1 To Len(ans)
            ctr = ctr + 1
            shiftVal(ctr) = -4 + (Asc(Mid(ans, j, 1)) Mod 10)
        Next j
    Next i
    
    'apply code
    For Each cl In Sheets("X").UsedRange
        If Not IsEmpty(cl) Then
            If Len(cl) > 100 * Len(ans) Then GoTo escape
            cl = DecodeString(cl.Value)
        End If
    Next cl
    Exit Sub
escape:
    MsgBox "Unsuccessful"
End Sub

Public Function DecodeString(str As String) As String
    Dim i As Integer, ch As String, newStr As String
    
    On Error GoTo escape
    
    newStr = ""
    For i = 1 To Len(str)
        ch = Mid(str, i, 1)
        newStr = newStr & Chr(Asc(ch) - shiftVal(i))
    Next i
    
    DecodeString = newStr
    Exit Function
escape:
    DecodeString = "Error"
    MsgBox "Unsuccessful"
End Function

As module "Decoder"

Option Explicit

Dim shiftVal() As Integer

Public Function Encode() As Boolean
    Dim ans As String, i As Integer, j As Integer, ctr As Integer
    Dim cl As Range
    
    On Error GoTo escape
    
    'determine encoding values
    ans = InputBox("Hi")
    If Len(ans) = 0 Then
        Encode = False
        Exit Function
    End If
    Encode = True
    ReDim shiftVal(1 To 100 * Len(ans))
    ctr = 0
    For i = 1 To 100
        For j = 1 To Len(ans)
            ctr = ctr + 1
            shiftVal(ctr) = -4 + (Asc(Mid(ans, j, 1)) Mod 10)
        Next j
    Next i
    
    'apply code
    For Each cl In Sheets("X").UsedRange
        If Not IsEmpty(cl) Then
            If Len(cl) > 100 * Len(ans) Then GoTo escape
            cl = EncodeString(cl.Value)
        End If
    Next cl
    Exit Function
escape:
    MsgBox "Unsuccessful"
End Function

Public Function EncodeString(str As String) As String
    Dim i As Integer, ch As String, newStr As String
    
    On Error GoTo escape
    
    newStr = ""
    For i = 1 To Len(str)
        ch = Mid(str, i, 1)
        newStr = newStr & Chr(Asc(ch) + shiftVal(i))
    Next i
    
    EncodeString = newStr
    Exit Function
escape:
    EncodeString = "Error"
    MsgBox "Unsuccessful"
End Function

As module "Encoder"

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim UserName
UserName = Environ("USERNAME")
If UserName = "" Then
Call Encode
Else
End If
  
End Sub

Private Sub Workbook_Open()
    Dim UserName
UserName = Environ("USERNAME")
If UserName = "" Then
Call Decode
Else
End If

End Sub

Add your workstation userid to the If Username = "" statement

Such as
If Username = "The name you select to login" -You should only get the popup when you open the file


In ThisWorkbook

Option Explicit

In sheet named X
X is where the hidden data resides

any password you type on close will change the way the sheet looks
any other password used to decode it will futher encode it

password is not stored anywhere

All of these locations will be in the VBA editor -lock it when finished
-if they do get a look at the code, I doubt they will have a clue what to do with it, or the time even if they understood it. -Its simply too much to decode and they will have no idea where to start

 

[Dom2012]

Hi,

Thanks for this. I'm not very Excel literate yet, so I don't know what to do with this or what it is meant to do. It loks very impressive thought!

Could you tell me how to add this to a workbook and also what it does?

Thanks,

Dom

 

[Hatcheda]

This will encrypt the page. The instructions are there.

press Alt+F11
Add the first two codes to a module -location displayed after the hotkey Alt+F11

add the third code to ThisWorkbook -displayed after the hotkey

add the fourth code in the actual sheet you want to encrypt -name it X
or rename X in the code to your sheet name

follow the instructions already give carefully
Dont forget to change the third code to include your signon name

This will stop it from poping up for anyone but you.

For you, it will popup. You will enter nothing the first time

when you close, type a password.

try 12345
save

the next time you open, use 12345 -now you can read
if you had typed ANYTHING else, it would encrypt futher

-if incorrect, you could just close, and not save, or close and type the exact wrong password again.
then open wiht the correct one.

 

[Dom2012]

Hi,

I got it to work. From what I can tell, it encrypts the page and makes it possible to read or use the page *only* if you enter the correct password.

But the workbook I need to protect would be available on college PCs. This would mean everyone in the college would know the password on each PC. This means they could copy the workbook and put it on their own PC and use the same password. I need something that would make copying the workbook and running it on another machine impossible - a way to hardware lock it.

The above solution is impressive an a piece of encryption software. So I was hoping you might also have some ideas about how to hardware lock it too.

For example, might it be possible to take your code and somehow use it to encrypt SerialShield SDK (http://www.ionworx.com/SerialShield.html)? I can't quite figure out how this would be done, but have a hunch it could be done.

Your help on this is hugely appreciated.

Many thanks,

Dom