Results 1 to 5 of 5
  1. #1
    Join Date
    Sep 2005
    Posts
    313

    Unanswered: open the same database on the computer

    Hi,

    I have a question.

    I created the database "Account".

    I open "Account" database, and then I go to the file and open it another one. Totally, I open twice on this file.

    I want to do that:
    When I open the "Account" database, the program check whether or not the Account database was already opened. If there was opened, then close the previous one. And, keep open the new one.

    Can we do that on VBA?

    Thanks.

  2. #2
    Join Date
    Feb 2005
    Posts
    333
    This should do the trick

    Code:
    If Dir(LFilename) <> "" Then Kill LFilename
    where lfilename is the path to your database
    Edit: YIKES don't do that. You'll delete your database. Sorry my head was somewhere else.
    Last edited by campster; 04-25-06 at 21:22.

  3. #3
    Join Date
    Apr 2004
    Location
    outside the rim
    Posts
    1,011
    Teddy recently posted a set of code that checks to see if a particular file is already open. Search back through the recent postings.

  4. #4
    Join Date
    Mar 2003
    Location
    The Bottom of The Barrel
    Posts
    6,102
    Provided Answers: 1
    The code I posted was to check if there were any windows with a particular string in the window handle present.

    This doesn't need to be so involved, check to see if YourDatabase.ldf is present.
    oh yeah... documentation... I have heard of that.

    *** What Do You Want In The MS Access Forum? ***

  5. #5
    Join Date
    Dec 2004
    Location
    Madison, WI
    Posts
    3,926

    Multiple instances of same db

    Here's the code to check for multiple instances of the same db.

    '******************** Code Start ********************
    Option Compare Database
    Option Explicit

    ' Module mdlCheckMultipleInstances
    ' Graham Mandeno, Alpha Solutions, Auckland, NZ
    ' graham@alpha.co.nz
    ' This code may be used and distributed freely on the condition
    ' that the above credit is included unchanged.

    Private Const cMaxBuffer = 255

    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 Const GW_CHILD = 5
    Private Const GW_HWNDNEXT = 2

    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 apiSetActiveWindow Lib "user32" _
    Alias "SetActiveWindow" _
    (ByVal hwnd As Long) _
    As Long

    Private Declare Function apiIsIconic Lib "user32" _
    Alias "IsIconic" _
    (ByVal hwnd As Long) _
    As Long

    Private Declare Function apiShowWindowAsync Lib "user32" _
    Alias "ShowWindowAsync" _
    (ByVal hwnd As Long, _
    ByVal nCmdShow As Long) _
    As Long

    Private Const SW_SHOW = 5
    Private Const SW_RESTORE = 9

    Public Function winGetClassName(hwnd As Long) As String
    Dim sBuffer As String, iLen As Integer
    sBuffer = String$(cMaxBuffer - 1, 0)
    iLen = apiGetClassName(hwnd, sBuffer, cMaxBuffer)
    If iLen > 0 Then
    winGetClassName = left$(sBuffer, iLen)
    End If
    End Function

    Public Function winGetTitle(hwnd As Long) As String
    Dim sBuffer As String, iLen As Integer
    sBuffer = String$(cMaxBuffer - 1, 0)
    iLen = apiGetWindowText(hwnd, sBuffer, cMaxBuffer)
    If iLen > 0 Then
    winGetTitle = left$(sBuffer, iLen)
    End If
    End Function

    Public Function winGetHWndDB(Optional hWndApp As Long) As Long
    Dim hwnd As Long
    winGetHWndDB = 0
    If hWndApp <> 0 Then
    If winGetClassName(hWndApp) <> "OMain" Then Exit Function
    End If
    hwnd = winGetHWndMDI(hWndApp)
    If hwnd = 0 Then Exit Function
    hwnd = apiGetWindow(hwnd, GW_CHILD)
    Do Until hwnd = 0
    If winGetClassName(hwnd) = "ODb" Then
    winGetHWndDB = hwnd
    Exit Do
    End If
    hwnd = apiGetWindow(hwnd, GW_HWNDNEXT)
    Loop
    End Function

    Public Function winGetHWndMDI(Optional hWndApp As Long) As Long
    Dim hwnd As Long
    winGetHWndMDI = 0
    If hWndApp = 0 Then hWndApp = Application.hWndAccessApp
    hwnd = apiGetWindow(hWndApp, GW_CHILD)
    Do Until hwnd = 0
    If winGetClassName(hwnd) = "MDIClient" Then
    winGetHWndMDI = hwnd
    Exit Do
    End If
    hwnd = apiGetWindow(hwnd, GW_HWNDNEXT)
    Loop
    End Function

    Public Function winCheckMultipleInstances(Optional fConfirm As Boolean = True) As Boolean
    Dim fSwitch As Boolean, sMyCaption As String
    Dim hWndApp As Long, hWndDb As Long
    On Error GoTo ProcErr
    sMyCaption = winGetTitle(winGetHWndDB())
    hWndApp = apiGetWindow(apiGetDesktopWindow(), GW_CHILD)
    Do Until hWndApp = 0
    If hWndApp <> Application.hWndAccessApp Then
    hWndDb = winGetHWndDB(hWndApp)
    If hWndDb <> 0 Then
    If sMyCaption = winGetTitle(hWndDb) Then Exit Do
    End If
    End If
    hWndApp = apiGetWindow(hWndApp, GW_HWNDNEXT)
    Loop
    If hWndApp = 0 Then Exit Function
    If fConfirm Then
    MsgBox sMyCaption & " is already open! This is a warning that you should check the bottom to verify that you already have the program open.", vbOKOnly
    Application.Quit
    End If
    apiSetActiveWindow hWndApp
    If apiIsIconic(hWndApp) Then
    apiShowWindowAsync hWndApp, SW_RESTORE
    Else
    apiShowWindowAsync hWndApp, SW_SHOW
    End If
    Application.Quit
    ProcEnd:
    Exit Function
    ProcErr:
    MsgBox err.Description
    Resume ProcEnd
    End Function
    '******************** Code End ********************
    Expert Database Programming
    MSAccess since 1.0, SQL Server since 6.5, Visual Basic (5.0, 6.0)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •