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

 

[kstrick9]

One last question: How would I go about adding a 2nd serial number using "or" in VBA. In other words, if it wasn't this serial number or a 2nd number, then it would prompt the password text box. Thanks

 

[kstrick9]

.

 

[musee]

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

Very
good, what about macro for doing the same in Powerpoint slideshow to verify computer ID when a button is clicked, and if the ID is not the same the user is directed to another slide in the slideshow for more information? Please help...

 

[bs04c]

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

hi guys! how do i enter this in excel te get the serial of my laptop? i need this to protect my excel files. thanks in advance for help!