How to get the serial number of UNC Drive Without API calling

Question

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

Answer 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