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

Question

我有下面的代码，如果它存在，它将使用已经打开的 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 意外关闭后仍然存在。

任何最受赞赏的想法。

Answer 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

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

Answer 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