close a database

[jmersing]

Is there a simple way to close a database if I have the path?

I'm using the runapp event to open a database that is on a network server. I just want to run some code in that database and then close it.

Thanks

 

[pritcham]

Hi

The only way I've been able to find is via API calls - I can't take credit for the code (Dev Ashish was the person who actually wrote it). I've included what I use below - works fine for me. I've made 1-2 changes to Dev's original code so you can close a particular instance of an app (identified by its window caption). You also need to know the application Class (Access is oMain) but if you run the 'fEnumWindows()' function while your DB is open it should confirm that for you.

There may be an easier way but this'll keep you going in the meantime.

Examples of usage are:

fCloseApp("oMain","This is my DBs Window Caption") ' This will only close the Access DB with a windows caption of "This is my DBs Window Caption"

fCloseApp("oMain") ' This will close all open instances of Access

Hope this helps
Martin

Private Declare Function apiGetClassName Lib "user32" Alias _
                "GetClassNameA" (ByVal hWnd As Long, _
                ByVal lpClassName As String, _
                ByVal nMaxCount As Long) As Long

Private Declare Function apiGetDesktopWindow Lib "user32" Alias _
                "GetDesktopWindow" () As Long

Private Declare Function apiGetWindow Lib "user32" Alias _
                "GetWindow" (ByVal hWnd As Long, _
                ByVal wCmd As Long) As Long

Private Declare Function apiGetWindowLong Lib "user32" Alias _
                "GetWindowLongA" (ByVal hWnd As Long, ByVal _
                nIndex As Long) As Long

Private Declare Function apiGetWindowText Lib "user32" Alias _
                "GetWindowTextA" (ByVal hWnd As Long, ByVal _
                lpString As String, ByVal aint As Long) As Long

Private Declare Function apiSendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal _
    wParam As Long, lParam As Long) As Long

Private Declare Function apiPostMessage _
    Lib "user32" Alias "PostMessageA" _
    (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long

Private Declare Function apiFindWindow _
    Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) _
    As Long
    
Private Declare Function apiWaitForSingleObject _
    Lib "kernel32" Alias "WaitForSingleObject" _
    (ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) _
    As Long
    
Private Declare Function apiIsWindow _
    Lib "user32" Alias "IsWindow" _
    (ByVal hWnd As Long) _
    As Long
        
Private Declare Function apiGetWindowThreadProcessId _
    Lib "user32" Alias "GetWindowThreadProcessId" _
    (ByVal hWnd As Long, _
    lpdwProcessID As Long) _
    As Long
Private Const mcGWCHILD = 5
Private Const mcGWHWNDNEXT = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255
Private Const WM_CLOSE = &H10
Private Const INFINITE = &HFFFFFFFF

Option Compare Database


' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'

Function fCloseApp(lpClassName As String, Optional sCaption As String)
Dim lngRet As Long, hWnd As Long, pID As Long
    hWnd = apiFindWindow(lpClassName, sCaption)
    If (hWnd) Then
        lngRet = apiPostMessage(hWnd, WM_CLOSE, 0, ByVal 0&)
        Call apiGetWindowThreadProcessId(hWnd, pID)
        Call apiWaitForSingleObject(pID, INFINITE)
        fCloseApp = Not (apiIsWindow(hWnd) = 0)
    End If
End Function


Function fEnumWindows()
Dim lngX As Long, lngLen As Long
Dim lngStyle As Long, strCaption As String
    
    lngX = apiGetDesktopWindow()
    'Return the first child to Desktop
    lngX = apiGetWindow(lngX, mcGWCHILD)
    
    Do While Not lngX = 0
        strCaption = fGetCaption(lngX)
        If Len(strCaption) > 0 Then
            lngStyle = apiGetWindowLong(lngX, mcGWLSTYLE)
            'enum visible windows only
            If lngStyle And mcWSVISIBLE Then
                Debug.Print "Class = " & fGetClassName(lngX),
                Debug.Print "Caption = " & fGetCaption(lngX)
            End If
        End If
        lngX = apiGetWindow(lngX, mcGWHWNDNEXT)
    Loop
End Function
Private Function fGetClassName(hWnd As Long) As String
    Dim strBuffer As String
    Dim intCount As Integer
   
    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = apiGetClassName(hWnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
        fGetClassName = Left$(strBuffer, intCount)
    End If
End Function

Private Function fGetCaption(hWnd As Long) As String
    Dim strBuffer As String
    Dim intCount As Integer

    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = apiGetWindowText(hWnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
        fGetCaption = Left$(strBuffer, intCount)
    End If
End Function

 

[Joe4]

I have Access databases that run code upon loading and then close automatically. So then all I have to do is open them and the rest happens automatically.

I have also seen where you can run code inside an Access database without actually opening the database itself, though I cannot locate it at the moment.

If either of these interest you, post back and I'll see what I can dig up.

 

[jmersing]

Thanks guys, I'll try the API code