-1

For security reasons I want my workbook can only be used if it is on a network. This network sometimes is mapped by users with different Letters. I would like to find a way to get the serial number of the network drive based on the UNC path instead of Drive Letter. But I would like to do it without API calling because some computers have issues on their Windows. I have the code below but is necessary the drive Letter. I want by UNC drive path instead.

Public Function HDSerialNumber() As String
  Dim fsObj As Object
  Dim Drv As Object
  Set fsObj = New Scripting.FileSystemObject
  Set Drv = fsObj.Drives("J")
  HDSerialNumber = Left(Hex(Drv.SerialNumber), 4) _
                 & "-" & Right(Hex(Drv.SerialNumber), 4)   
End Function
Hasitha Jayawardana
  • 2,326
  • 4
  • 18
  • 36
Luthius
  • 1
  • 5
  • You know that this is not secure at all? One can easily disable macros to disable this check. Also what if the admin of the server replaces a broken hard drive, or the server? The serial will change. • Also be aware that `FileSystemObject` does not work with Mac. – Pᴇʜ Jul 15 '19 at 11:45
  • Firstly, completely agree with @Pᴇʜ! Second, why not just use the UNC path rather than trying to get drive letter or serial number? – Zac Jul 15 '19 at 11:50
  • @Zac I think because you could easily fake the UNC path with a virtual server or something. But probably you can fake the serial too ;) – Pᴇʜ Jul 15 '19 at 11:52
  • @Pᴇʜ exactly.. I don't see the advantage of serial number. Like you mentioned, non of this is secure anyway :) – Zac Jul 15 '19 at 11:54
  • A secure way could be to send a challange to a service on the server, and see if the server answers the challange correctly. But still you can easily trick out the macro by disabling macros. – Pᴇʜ Jul 15 '19 at 11:58
  • When the Application is run, It will query the registry of the server looking for a specific value. If it doesn't find the reg entry, then it will ask the user to create an entry in the server using "Server Admin" Rights. – Siddharth Rout Jul 15 '19 at 12:19
  • Guys we are talking about an Excel Workbook that is used on a network. I don't want this file been copied without a proper authorization, etc. There are ways to avoid the user get access to the Sheet Tabs when disabling macros such as xlSheetVeryHidden property with a protected VBE modules. Sure that a lot of disvantages and pitfalls can exist but my query is not for a bullet proof solution, just one way to avoid users copy the file from the network. I guess using a serial number could be a simple solution, but I'm open for new ideas. – Luthius Jul 15 '19 at 12:34
  • If you are referring to my comment then yes my comment is for an "Excel Workbook that is used on a network" – Siddharth Rout Jul 15 '19 at 12:35
  • How would be the code as per your approach @Siddharth Rout ? – Luthius Jul 15 '19 at 12:47
  • Search google for `vba remote registry key` – Siddharth Rout Jul 15 '19 at 12:50

1 Answers1

1

Just for your interest. If you try to hide information in a workbook with a combination of xlSheetVeryHidden and VBA you can easily trick that with the following code:

You just need to put this code into a new workbook (enter the filename you want to attack) and run it. It will open your file (prevent your code in the file from running) and make all sheets visible.

That's how easily all your effort checking serials etc. is tricked out with only 10 lines of code.

Sub ShowAllWorkbooks()
    Dim OpenWb As Workbook
    Application.EnableEvents = False 'prevent autorun of workbook_open and other events
    Set OpenWb = Workbooks.Open(Filename:="PathToFileYouWantToShow")

    Dim ws As Worksheet
    For Each ws In OpenWb.Worksheets
        ws.Visible = xlSheetVisible
    Next ws
    Application.EnableEvents = True
End Sub

This works even if your VBA code is password protected from viewing.

If you don't care about that security hole, then I suggest the following:

Add this to your Workbook_Open event:

Option Explicit

Private Sub Workbook_Open()
    If ThisWorkbook.Path <> "your server path" Then
        MsgBox "This file can only be run from the server!"
        ThisWorkbook.Close SaveChanges:=False
    Else
        'make all worksheets visible
    End If
End Sub

It will check if the current workbook was opened/started from "your server path" if not it will immediately close the workbook.

Alternatively just check if your UNC Path exists:

Option Explicit

Private Sub Workbook_Open()
    Dim Fso As Object
    Set Fso = CreateObject("Scripting.FileSystemObject")

    If Not Fso.FolderExists("your server path") Then
        MsgBox "This file can only be run from the server!"
        ThisWorkbook.Close SaveChanges:=False
    Else
        'make all worksheets visible
    End If
End Sub
Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73