Access 2010-如果在特定位置打开则关闭数据库的VBA命令

Question

我正在尝试在加载表单时创建事件过程，如果从共享驱动器上的特定位置访问文件，则会关闭数据库。

我的第一次尝试看起来像这样：

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

但是，由于此文件位于共享驱动器上，因此用户可能正在从不同的驱动器（但是同一服务器/路径）访问该文件。因此，例如，在我的代码中，C驱动器并不适合所有人。某些用户可能正在从其计算机上的J驱动器或L驱动器访问服务器。

我有办法解决这个问题，还是有更好的方法？

注意：我可以解决此问题的一种方法是，改为说

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

但是我想避免这种情况。

Answer 1

下面将返回映射驱动器的UNC路径（如果它是映射驱动器）：

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

然后您可以针对您的网络路径对此进行测试。

Answer 2

首先，我永远不会在VBA中对路径或UNC进行硬编码。如果您的用户对该文件夹具有写访问权限（共享或不共享），他们将能够创建一个子文件夹，将访问文件的副本放入其中，然后打开数据库...

似乎您希望用户只能在其工作站上本地打开数据库，在这种情况下，我将进行不同的检查。

请让我知道...

Answer 3

您可以检查文件是否在网络或本地驱动器上。

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

因此，您的情况：

If DrvObj <> 2 then Docmd.Quit

希望这会有所帮助

Answer 4

首先，免责声明。我从未使用过较新的访问权限。

但是，我很确定以下逻辑是正确的。

1. 您不需要声明任何fso对象。
2. 我假设CurrentProject.Path与旧的CurrentDb.Name相似

桌面应用程序的所有路径都将解析为其中一个

“ x：\ Path \”或

“ \\ Path”

因此，chr @ P2将为“：”或“ \”

所以，

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

编辑：

我刚想到...

为什么用户会有不同的驱动器路径？

这应该是前端后端解决方案。

所有用户都通过其本地“ C：\”驱动器访问前端

所有表都应作为专用网络资源链接到后端共享。“ x：\ maindb”或“ \ maindb”。

假设您要自定义参数或sec pr用户。

在这种情况下，所有用户都将“ c：\”报告为CurrentProject.Path

在这种情况下，没有用户会在关闭时报告非C驱动器。

所以，一个问题。您是否将此数据库分为前端-后端？