VBAを使用すると、開いている場合は既存のデータベースを使用し、それ以外の場合は新しいデータベースを開きます。

Question

既に開いている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

それは適切に。

Answer 2

IMO最も簡単な方法は、.laccdbファイルを削除しようとすることです。そこに存在し、（ロックされているため）削除できない場合、Dbは使用中です。それはすでに開いている場合

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 

私は前に私の元のコードを呼び出すにテストすることができ、その後、その後の対処：私は、私は問題を解決し、この中に別の目的のためにいた別の関数をクローバするために管理

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