通过VBA如果打开则使用现有数据库，否则打开新数据库然后关闭

Posted 2023-05-07

【中文标题】通过VBA如果打开则使用现有数据库，否则打开新数据库然后关闭

【英文标题】：Through VBA use existing database if open, otherwise open new one then close after

【发布时间】：2016-10-03 16:01:48

【问题描述】：

我有下面的代码，如果它存在，它将使用已经打开的 Access 数据库，如果没有，它将使用新的 Access 实例。这工作正常。

Sub DoStuff()
Dim AccApp As Application
Set AccApp = GetObject("C:\DatabaseName.accdb")
--Do Something e.g.
Debug.Print AccApp.CurrentDb.Name
Set AccApp = Nothing
End Sub

在此之后我想做的是让数据库保持打开状态，如果它已经打开，但如果它不开始就关闭它。我如何判断它是否存在。

我不想测试 laccdb 文件，因为这些文件在 Access 意外关闭后仍然存在。

任何最受赞赏的想法。

【问题讨论】：

您的代码已经这样做了（至少在 Office 2013 中）。当我对此进行测试时，AccApp 实例在其引用计数为 0 时关闭。如果您在另一个实例中打开 DatabaseName.accdb，则当 AccApp 超出范围时它不会关闭。

【参考方案1】：

我设法将我出于其他目的而拥有的另一个功能加入其中，从而解决了这个问题：

Function bDatabaseOpen(strDBPath As String) As Boolean
Dim objWMIService As Object, colProcessList As Object, objProcess As Object

bDatabaseOpen = False

Set objWMIService = GetObject("winmgmts:impersonationLevel=impersonate!\\.\root\cimv2")

Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where Name = 'MSACCESS.EXE'")

For Each objProcess In colProcessList
If Not (IsNull(objProcess.commandline)) Then
    If objProcess.commandline Like "*" & strDBPath & "*" Then
        bDatabaseOpen = True
    End If
End If
Next

Set objProcess = Nothing
Set objWMIService = Nothing
Set colProcessList = Nothing
End Function

我可以在调用我的原始代码之前测试它是否已经打开，然后再进行适当的处​​理。

【参考方案2】：

IMO 最简单的方法是尝试删除 .laccdb 文件。如果它在那里并且无法删除（因为它已被锁定），则 Db 正在使用中。

Const TheDB = "C:\DatabaseName.accdb"

Dim DbWasOpen As Boolean
Dim slaccdb As String

slaccdb = Replace(TheDB, ".accdb", ".laccdb")

DbWasOpen = False
If Dir$(slaccdb) <> "" Then
    On Error Resume Next
    ' Try to delete .laccdb
    Kill slaccdb
    ' If that fails, the database is in use
    If Err.Number <> 0 Then
        DbWasOpen = True
    End If
    On Error GoTo 0
End If

【讨论】：

好的，但是如果其他用户打开了数据库，那么不管怎样，laccdb 文件都会在那里。我不是想以独占方式打开它，只是使用现有的打开实例（然后保持打开状态）或打开一个新实例并在之后关闭它。