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

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

2 个答案: