Closing a workbook if it is not located in a specific directory

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
871
Office Version
  1. 365
Platform
  1. Windows
Hello, I know that it is not possible to prevent someone from copying an excel workbook however I was wondering if it was possible to disable the copied workbook?
That if the sheet is opened from a different location than the original (I can specify the directory in a cell on a hidden sheet) it will close down with a message like "This is a copy of the original workbook and therefore cannot be used. Please open the correct workbook" and close the file.

Is this possible? I have a spreadsheet at work that many users utilize but apparently at one point an individual copied the sheet and now we have overlapping records. It is a mess and I am trying to prevent reoccurance.
Thank you to anyone who can help!
 
Have VBA tell you exactly what it thinks each value is, i.e.
after this line of code:
VBA Code:
        If .FullName <> FullFileName Then
temporarily add this line:
VBA Code:
MsgBox .FullName & vbCrLf & FullFileName

That will return a two-line Message Box, which show you the value of those two things, so you can easily see what their differences are.
 
Upvote 0

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Have VBA tell you exactly what it thinks each value is, i.e.
after this line of code:
VBA Code:
        If .FullName <> FullFileName Then
temporarily add this line:
VBA Code:
MsgBox .FullName & vbCrLf & FullFileName

That will return a two-line Message Box, which show you the value of those two things, so you can easily see what their differences are.
Thank you, I got it to work on my computer but again have another problem.
This file is on a network and can be accessed from many locations. Some of the locations label the drive as X

X:\ADMINISTRATION\QAEng\Carla's Documents\Test\Batch Log.xlsm

however the universal name so to speak is a number:
\\192.168.1.20\cdata\ADMINISTRATION\QAEng\Carla's Documents\Test\Batch Log.xlsm

If I use thE number reference in F1 it does not work for my computer (and probably others) but will work for a different computer that uses the number.

I am not sure I understand it. I can get VBA to open files using: \\192.168.1.20\cdata however this particular code does not seem to work.

Any ideas?
 
Upvote 0
Hmm, I am not sure why the UNC is not working for you.

If you cannot get that to work, maybe start checking the file path from the second character, so as to exclude the drive letter (as you said, different computer's have different drive mappings), i.e.
VBA Code:
        If Mid(.FullName,2) <> Mid(FullFileName,2) Then
 
Upvote 0
Hmm, I am not sure why the UNC is not working for you.

If you cannot get that to work, maybe start checking the file path from the second character, so as to exclude the drive letter (as you said, different computer's have different drive mappings), i.e.
VBA Code:
        If Mid(.FullName,2) <> Mid(FullFileName,2) Then

I tried your modified code and unfortunately I still get the same error (from my computer with the X Drive).

I checked the paths on 3 different computers in the office and got 3 different paths for the same document (I think the max is these 3)

X:\ADMINISTRATION\QAEng\Carla's Documents\Test\Batch Log.xlsm
\\Davinci-12\cddata\ADMINISTRATION\QAEng\Carla's Documents\Test\Batch Log.xlsm
\\192.168.1.20\cdata\ADMINISTRATION\QAEng\Carla's Documents\Test\Batch Log.xlsm

Batch Log.xlsm
EF
1File Directory:X:\ADMINISTRATION\QAEng\Carla's Documents\Test\Batch Log.xlsm
2\\Davinci-12\cddata\ADMINISTRATION\QAEng\Carla's Documents\Test\Batch Log.xlsm
3\\192.168.1.20\cdata\ADMINISTRATION\QAEng\Carla's Documents\Test\Batch Log.xlsm
List


Any further ideas? Maybe a code that says if it does not match one of the 3 then give the message?

Sorry for the complicated inquiry
 
Upvote 0
If the path never changes, maybe you could search everything from "ADMINISTRATION" on, using a combination of INSTR (to find where that starts), and the MID function.
 
Upvote 0
If the path never changes, maybe you could search everything from "ADMINISTRATION" on, using a combination of INSTR (to find where that starts), and the MID function.
The path never changes however to be honest I would not know how to write that...
 
Upvote 0
Also could the key word "Administration" be a cell reference that a user can modify so they have the ability to move the file if ever the need arises?
I try to make little "hard coded" in VB if possible
 
Upvote 0
Something like this then:
VBA Code:
    Dim firstFolder As String
    Dim fn1 As String
    Dim fn2 As String
    
'   Get value to search for from cell A1 ("Administration")
    firstFolder = Range("A1")
    
'   Get substrings of two file path values to compare
    fn1 = Mid(.FullName, InStr(UCase(.FullName), UCase(firstFolder)))
    fn2 = Mid(FullFileName, InStr(UCase(FullFileName), UCase(firstFolder)))
    
'   Then do comparison
    If fn1 <> fn2 Then
 
Upvote 0
Something like this then:
VBA Code:
    Dim firstFolder As String
    Dim fn1 As String
    Dim fn2 As String
  
'   Get value to search for from cell A1 ("Administration")
    firstFolder = Range("A1")
  
'   Get substrings of two file path values to compare
    fn1 = Mid(.FullName, InStr(UCase(.FullName), UCase(firstFolder)))
    fn2 = Mid(FullFileName, InStr(UCase(FullFileName), UCase(firstFolder)))
  
'   Then do comparison
    If fn1 <> fn2 Then
I get a compile error: Invalid or unqualified reference on line: fn1 = Mid(.FullName, InStr(UCase(.FullName), UCase(firstFolder)))

VBA Code:
Private Sub Workbook_Open()
    Application.Calculation = xlAutomatic
    Application.CalculateBeforeSave = True
    Dim firstFolder As String
    Dim fn1 As String
    Dim fn2 As String
    Const AllowCancel = True
   firstFolder = Range("F1")
   fn1 = Mid(.FullName, InStr(UCase(.FullName), UCase(firstFolder)))
    fn2 = Mid(FullFileName, InStr(UCase(FullFileName), UCase(firstFolder)))
    With ActiveWorkbook
        If fn1 <> fn2 Then
                    Dim choice As Long, bttns As Long
            If AllowCancel Then bttns = vbOKCancel Else bttns = vbOKOnly
            choice = MsgBox("This is a copy of the original workbook and therefore cannot be used. Please open the correct workbook.", bttns)
            If choice = vbOK Then .Close

        End If
    End With
End Sub

Batch Log.xlsm
EF
1File Directory Main:ADMINISTRATION
List
 
Upvote 0
The "fn1" calculation must be AFTER your "With Activeworkbook" line.

Note that any references that start with a ".", like .FullName are only valid with in a "With" block.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,253
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top