Unique computer ID verification prior to opening workbook using VBA

[kstrick9]

Fairly new to VBA code here. I have a condition setup (under "This Workbook") upon opening a spreadsheet to verify a computer's predetermined motherboard serial number that will shut the Excel workbook down if the numbers do not match. This works fine. What I'd like to do is to add a second condition that will allow a password to be entered in a textbox if the numbers do not match so that the serial number condition could be manually overridden, if necessary. If the serial number and the password are incorrect the workbook automatically closes. Thanks in advance for any help!

Here is the code that works:

Private Sub Workbook_Open()
If CreateObject("Scripting.FileSystemObject").GetDrive("C:\").SerialNumber <> "-XXXXXXX" Then ActiveWorkbook.Close False
End Sub

Here is what I am attempting to do that is not functioning properly - need to add a textbox to enter a password to override an incorrect serial number

Private Sub Workbook_Open()
If CreateObject("Scripting.FileSystemObject").GetDrive("C:\").SerialNumber <> "-XXXXXXX" Then
Dim Rng
Rng = InputBox("aaaaaa")
If Rng <> "aaaaaa" Then ActiveWorkbook.Close False
End Sub

 

[JackDanIce]

Welcome to MrExcel, does this do as you would like:

Private Sub Workbook_Open()
Dim Rng As String
If CreateObject("Scripting.FileSystemObject").GetDrive("C:\").SerialNumber <> "-XXXXXXX" Then
    Rng = InputBox("Enter password:")
    If LCaseRng <> "aaaaaa" Then ActiveWorkbook.Close False
End If
End Sub

 

[kstrick9]

JackDanIce,

Thanks for the quick reply. After entering the password correctly the workbook still closes. I tried changing false to true after ActiveWorkbook.Close and the results were the same. Any idea what could be causing this? Thanks

 

[Kyle123]

    If LCaseRng <> "aaaaaa" Then ActiveWorkbook.Close False

Should be

    If LCase(Rng) <> "aaaaaa" Then ActiveWorkbook.Close False

If you use option explicit, you won't get errors like this

 

[kstrick9]

Kyle123, this solved my issue. Thanks to all that helped!

 

[Kyle123]

What if the user disables macros?

 

[kstrick9]

Kyle123,

The sheet is useless without macros enabled. Do you have any suggestions for closing a sheet if macors are disabled? I researched this before and there is a solution that hides/unhides all sheets. The problem with that is that I have many sheets that need to stay hidden. thanks

 

[Kyle123]

Not reliably, Excel Security is beyond rubbish and anyone who is so inclined can see your code even if you password protect it. So I'm always interested in what approaches people have taken to secure workbooks - I've never seen a reliable way yet, but there may be one out there

 

[kstrick9]

Kyle123, thanks. DataSafeXL may be a solution to protect sheets and VBA code.

For anyone that may be interested in using this code, here it is (new to posting and not sure how to put code in boxes...sorry):

Private Sub Workbook_Open()
Dim Rng As String
If CreateObject("Scripting.FileSystemObject").GetDrive("C:\").SerialNumber <> "-get using code below and manually enter" Then
Rng = InputBox("Conflicting Computer ID numbers. Please enter password to gain access to program:")
If LCase(Rng) <> "yourpassword" Then ActiveWorkbook.Close False
End If
End Sub

Use this to get serial number:

Sub ShowDriveInfo()
Dim fs, d, s, t
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))
Select Case d.DriveType
Case 0: t = "Unknown"
Case 1: t = "Removable"
Case 2: t = "Fixed"
Case 3: t = "Network"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"
End Select
s = d.SerialNumber
Range("A1") = s
End Sub

 

[Kyle123]

hmmm, maybe, though all it really seems to do is change your variable names and remove comments and it wouldn't hide your password

You can use code tags by [ code ] your code [ / code ] (remove the spaces)