CODEWITHSUNDEEP
ms-accessvba
Tim Edwards
Tim Edwards

Reputation: 1028

Through VBA use existing database if open, otherwise open new one then close after

I have the below code which will use an already open Access database if it's there, if not it will use a new Access instance. This is working fine.

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

What I want to do after this is to leave the database open if it was already open but close it if it wasn't to start with. How can I tell whether it was there or not to start with.

I don't want to test for laccdb files as these can remain after Access closing unexpectedly.

Any ideas most appreciated.

Upvotes: 0

Views: 1054

Answers (2)

Tim Edwards
Tim Edwards

Reputation: 1028

I managed to crowbar another function I had for another purpose into this which solves the issue:

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

I can test prior to calling my original code if it's already open and then afterwards deal with it appropriately.

Upvotes: 1

Andre
Andre

Reputation: 27634

IMO the easiest way is to try to delete the .laccdb file. If it's there and can't be deleted (because it is locked), the Db is in use.

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

Upvotes: 0

Related Questions