CODEWITHSUNDEEP
vbams-accessms-access-2010
Dee Wolf
Dee Wolf

Reputation: 27

Access 2010 - VBA Command to Close Database if Opened in a Specific Location

I am trying to create an event procedure when the form loads that will close the database if the file is accessed from a specific location on a shared drive.

My first attempt looked something like this:

On Error Resume Next
Dim GetPath As String
GetPath = CurrentProject.Path
If GetPath = "C:\Folder1\Folder2" Then
    DoCmd.Quit
End If

However, since this file is located on a shared drive, users may be accessing the file from different drives (but the same server/pathway). So, for example, in my code the C drive wouldn't work for everyone. Some users may be accessing the server from J drive or L drive on their computer.

Is there a way I can get around this, or is there a better method?

Note: One way I could get around this problem would be to, instead, say

If GetPath <> "desired pathway" Then 
DoCmd.Quit

But I want to avoid this if possible.

Upvotes: 0

Views: 2067

Answers (5)

Ian Felton
Ian Felton

Reputation: 91

This is almost exactly what you are using. I haven't tried your version, but this has worked for me.

Function CheckIfMasterFile()

    On Error GoTo ErrorHandler

    Dim MasterFileLocation As String
    MasterFileLocation = "C:\Some_Folder\Some_Other_Folder\Folder_File_Resides_In"

    If Application.CurrentProject.Path = MasterFileLocation Then
        'MsgBox ("You have opened the Master file.")
        Application.Quit acQuitPrompt
    End If

ExitFunction:
  Exit Function

ErrorHandler:
  MsgBox (Err.Description)
  Resume ExitFunction:


End Function

Upvotes: 1

rockmo
rockmo

Reputation: 566

To begin, a disclaimer. I've never worked with newer access.

But, I'm pretty sure the following logic is correct.

  1. You don't need to declare any fso object.
  2. I assume CurrentProject.Path is similar to old CurrentDb.Name

All Paths for a desktop app will resolve to either

"x:\Path\" or

"\\Path"

Therefore, the chr @ P2 will be ":" or "\"

So,

sDB = CurrentProject.Path

Select case Mid, (sDB, 2, 1)
  Case ":"
  ' May be local, or -- networked if map network enabled
  ' We can use WMI, FSO, API to discover but that can be slow 
  ' (up to 750ms just to invoke)
  '
  ' Since we can easily inspect if root just by checking C:\

    If left(sdb,1) <> "C" then 
     ' Definit4ely networked
     '... do things close
    End If  

  Case "\"
    ' Definit4ely networked
    '... do things close
Emd Select

Edit:

It just occurred to me...

Why would users have different drive paths?

This should be a Front-End Back-End solution.

Such that all users access the front end via their local "C:\" drive

all tables should be linked to a back-end share as a dedicated network resource.. either "x:\maindb" or "\maindb".

That's assuming you want custom params or sec pr user.

In which case, all users will report "c:\" as CurrentProject.Path

Under such a scenario, no user would report a non C drive on close.

So, a question. Have you split this db into front end-back end?

Upvotes: 0

Cisco
Cisco

Reputation: 251

you can check if your file is on a network or local drive.

Dim fsoObj As Object ' File System Object
Dim drvObj As Object ' Drive

Set fsoObj = CreateObject("scripting.filesystemobject")
Set drvObj = fsoObj.GetDrive(fsoObj.GetDriveName(Application.CodeDB.Name))

' DriveType
' 1   Removable (for example a USB Stick)
' 2   Fixed Hard Drive
' 3   Network Drive
' 4   CD-ROM
' 5   RAM Drive

So in your case:

If DrvObj <> 2 then Docmd.Quit

Hope this helps

Upvotes: 0

user5882161
user5882161

Reputation: 1

first of all, I would never hardcode a path or UNC in VBA. If your users have write access for this folder (shared or not), they will be able to create a sub-folder, place a copy of your access file inside and then open the database...

It seems that you want that users can open your database only locally on their workstation, and in this case I would check that differently.

Please let me know...

Upvotes: 0

andrew
andrew

Reputation: 1816

The below should return you the mapped drive's UNC path (if it is a mapped drive):

Function GetActualPath(sPath) As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim drive As Object
    Set drive = fso.GetDrive(fso.GetDriveName(sPath))
    If Len(drive.ShareName) > 0 Then
        'swap out the mapped letter for the share path
        GetActualPath = Replace(sPath, drive.Path, drive.ShareName)
    Else
        'use the path provided
        GetActualPath = sPath
    End If
End Function

You can then test this against your network path.

Upvotes: 2

Related Questions