By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,671 Members | 1,315 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,671 IT Pros & Developers. It's quick & easy.

winCheckMultipleInstances not working AC2010.

TheSmileyCoder
Expert Mod 100+
P: 2,321
I have found that users sometimes minimize my application, and then later, start it "again" thus starting a new instance of the program.

I want to prevent this from happening.

Current setup:
Frontend is a MDE file.
Backend is mdb file on shared network drive.
Acccess Version: 2010
Windows 7

I found this code at http://access.mvps.org/access/api/api0041.htm.

The problem is I can't get it to work, the sMyCaption variable is set to "" thus it doesn't really matter what happens in the rest of the code. I have tried and tried to understand the API calls, but I am getting nowhere and my head starts to hurt! I would appreciate it if anyone with more API skills then me, can spot what might go wrong.

Expand|Select|Wrap|Line Numbers
  1. '******************** Code Start ********************
  2. ' Module mdlCheckMultipleInstances
  3. '  Graham Mandeno, Alpha Solutions, Auckland, NZ
  4. ' graham@alpha.co.nz
  5. ' This code may be used and distributed freely on the condition
  6. '  that the above credit is included unchanged.
  7.  
  8. Private Const cMaxBuffer = 255
  9.  
  10. Private Declare Function apiGetClassName Lib "user32" _
  11.   Alias "GetClassNameA" _
  12.   (ByVal hWnd As Long, _
  13.   ByVal lpClassName As String, _
  14.   ByVal nMaxCount As Long) _
  15.   As Long
  16.  
  17. Private Declare Function apiGetDesktopWindow Lib "user32" _
  18.   Alias "GetDesktopWindow" _
  19.   () As Long
  20.  
  21. Private Declare Function apiGetWindow Lib "user32" _
  22.   Alias "GetWindow" _
  23.   (ByVal hWnd As Long, _
  24.   ByVal wCmd As Long) _
  25.   As Long
  26.  
  27. Private Const GW_CHILD = 5
  28. Private Const GW_HWNDNEXT = 2
  29.  
  30. Private Declare Function apiGetWindowText Lib "user32" _
  31.   Alias "GetWindowTextA" _
  32.   (ByVal hWnd As Long, _
  33.   ByVal lpString As String, _
  34.   ByVal aint As Long) _
  35.   As Long
  36.  
  37. Private Declare Function apiSetActiveWindow Lib "user32" _
  38.   Alias "SetActiveWindow" _
  39.   (ByVal hWnd As Long) _
  40.   As Long
  41.  
  42. Private Declare Function apiIsIconic Lib "user32" _
  43.   Alias "IsIconic" _
  44.   (ByVal hWnd As Long) _
  45.   As Long
  46.  
  47. Private Declare Function apiShowWindowAsync Lib "user32" _
  48.   Alias "ShowWindowAsync" _
  49.   (ByVal hWnd As Long, _
  50.   ByVal nCmdShow As Long) _
  51.   As Long
  52.  
  53. Private Const SW_SHOW = 5
  54. Private Const SW_RESTORE = 9
  55.  
  56. Public Function winGetClassName(hWnd As Long) As String
  57. Dim sBuffer As String, iLen As Integer
  58.   sBuffer = String$(cMaxBuffer - 1, 0)
  59.   iLen = apiGetClassName(hWnd, sBuffer, cMaxBuffer)
  60.   If iLen > 0 Then
  61.     winGetClassName = Left$(sBuffer, iLen)
  62.   End If
  63. End Function
  64.  
  65. Public Function winGetTitle(hWnd As Long) As String
  66. Dim sBuffer As String, iLen As Integer
  67.   sBuffer = String$(cMaxBuffer - 1, 0)
  68.   iLen = apiGetWindowText(hWnd, sBuffer, cMaxBuffer)
  69.   If iLen > 0 Then
  70.     winGetTitle = Left$(sBuffer, iLen)
  71.   End If
  72. End Function
  73.  
  74. Public Function winGetHWndDB(Optional hWndApp As Long) As Long
  75. Dim hWnd As Long
  76. winGetHWndDB = 0
  77. If hWndApp <> 0 Then
  78.   If winGetClassName(hWndApp) <> "OMain" Then Exit Function
  79. End If
  80. hWnd = winGetHWndMDI(hWndApp)
  81. If hWnd = 0 Then Exit Function
  82. hWnd = apiGetWindow(hWnd, GW_CHILD)
  83. Do Until hWnd = 0
  84.   If winGetClassName(hWnd) = "ODb" Then
  85.     winGetHWndDB = hWnd
  86.     Exit Do
  87.   End If
  88.   hWnd = apiGetWindow(hWnd, GW_HWNDNEXT)
  89. Loop
  90. End Function
  91.  
  92. Public Function winGetHWndMDI(Optional hWndApp As Long) As Long
  93. Dim hWnd As Long
  94. winGetHWndMDI = 0
  95. If hWndApp = 0 Then hWndApp = Application.hWndAccessApp
  96. hWnd = apiGetWindow(hWndApp, GW_CHILD)
  97. Do Until hWnd = 0
  98.   If winGetClassName(hWnd) = "MDIClient" Then
  99.     winGetHWndMDI = hWnd
  100.     Exit Do
  101.   End If
  102.   hWnd = apiGetWindow(hWnd, GW_HWNDNEXT)
  103. Loop
  104. End Function
  105.  
  106. Public Function winCheckMultipleInstances(Optional fConfirm As Boolean = True) As Boolean
  107. Dim fSwitch As Boolean, sMyCaption As String
  108. Dim hWndApp As Long, hWndDb As Long
  109. On Error GoTo ProcErr
  110.   sMyCaption = winGetTitle(winGetHWndDB())
  111.   hWndApp = apiGetWindow(apiGetDesktopWindow(), GW_CHILD)
  112.   Do Until hWndApp = 0
  113.     If hWndApp <> Application.hWndAccessApp Then
  114.       hWndDb = winGetHWndDB(hWndApp)
  115.       If hWndDb <> 0 Then
  116.         If sMyCaption = winGetTitle(hWndDb) Then Exit Do
  117.       End If
  118.     End If
  119.     hWndApp = apiGetWindow(hWndApp, GW_HWNDNEXT)
  120.   Loop
  121.   If hWndApp = 0 Then Exit Function
  122.   If fConfirm Then
  123.     If MsgBox(sMyCaption & " is already open@" _
  124.       & "Do you want to open a second instance of this database?@", _
  125.       vbYesNo Or vbQuestion Or vbDefaultButton2) = vbYes Then Exit Function
  126.   End If
  127.   apiSetActiveWindow hWndApp
  128.   If apiIsIconic(hWndApp) Then
  129.     apiShowWindowAsync hWndApp, SW_RESTORE
  130.   Else
  131.     apiShowWindowAsync hWndApp, SW_SHOW
  132.   End If
  133.   Application.Quit
  134. ProcEnd:
  135.   Exit Function
  136. ProcErr:
  137.   MsgBox Err.Description
  138.   Resume ProcEnd
  139. End Function
  140. '******************** Code End ********************
  141.  
May 24 '12 #1
Share this Question
Share on Google+
7 Replies


NeoPa
Expert Mod 15k+
P: 31,276
If the users have their own copy of the FE then it might be easier simply to check the size of the LDB file. Painless and reliable.
May 24 '12 #2

TheSmileyCoder
Expert Mod 100+
P: 2,321
I did consider that, but I believe if the access application exits in error, that the .ldb file is left behind, and not cleaned up. How would you handle that?
May 24 '12 #3

ADezii
Expert 5K+
P: 8,607
@TheSmileyCoder:
  1. I made a very subtle change in the Entry Level Function which really was not necessary.
  2. The Code works exactly as intended, as long as:
    1. You do not Pass a False Argument to the winCheckMultipleInstances() Function, as in:
      Expand|Select|Wrap|Line Numbers
      1. winCheckMultipleInstances(False)
    2. Your Code for winCheckMultipleInstances() is exactly as follows:
      Expand|Select|Wrap|Line Numbers
      1. Public Function winCheckMultipleInstances(Optional fConfirm As Boolean = True) As Boolean
      2. Dim fSwitch As Boolean, sMyCaption As String
      3. Dim hWndApp As Long, hWndDb As Long
      4.  
      5. On Error GoTo ProcErr
      6. sMyCaption = winGetTitle(winGetHWndDB())
      7.  
      8. hWndApp = apiGetWindow(apiGetDesktopWindow(), GW_CHILD)
      9.  Do Until hWndApp = 0
      10.    If hWndApp <> Application.hWndAccessApp Then
      11.      hWndDb = winGetHWndDB(hWndApp)
      12.        If hWndDb <> 0 Then
      13.          If sMyCaption = winGetTitle(hWndDb) Then Exit Do
      14.        End If
      15.    End If
      16.    hWndApp = apiGetWindow(hWndApp, GW_HWNDNEXT)
      17.  Loop
      18.  
      19. If hWndApp = 0 Then Exit Function
      20.  
      21. If fConfirm Then
      22.   If MsgBox(sMyCaption & " is already open@" _
      23.     & "Do you want to open a second instance of this database?@", _
      24.      vbYesNo Or vbQuestion Or vbDefaultButton2) = vbYes Then Exit Function
      25.  
      26.   apiSetActiveWindow hWndApp
      27.  
      28.   If apiIsIconic(hWndApp) Then
      29.     apiShowWindowAsync hWndApp, SW_RESTORE
      30.   Else
      31.     apiShowWindowAsync hWndApp, SW_SHOW
      32.   End If
      33. End If
      34.  
      35. Application.Quit
      36.  
      37. ProcEnd:
      38.   Exit Function
      39. ProcErr:
      40.   MsgBox Err.Description
      41.     Resume ProcEnd
      42. End Function
      43.  
May 24 '12 #4

NeoPa
Expert Mod 15k+
P: 31,276
Smiley:
if the access application exits in error, that the .ldb file is left behind, and not cleaned up. How would you handle that?
Just as you would normally. Delete the file, then everything works normally again. You wouldn't expect everything to work perfectly when you had spurious files around.

Actually, it's a bonus, as it draws atention to the problem rather than leaving it there unnoticed until it mucks up something else - possibly in a way that's more subtle and hard to ascertain ;-)

PS. This seems to me to be a perfect illustration of the KISS concept.
May 24 '12 #5

TheSmileyCoder
Expert Mod 100+
P: 2,321
@ adezii, Are you getting a non empty string value in sMyCaption? And what version of access are you using? I cant help but wonder if this is in someway related to me using Ac2010 and the code simply breaks in 2010.

@NeoPa How would you detect whether the a existing .ldb is the result of a bad exit (crash) or the result of the app allready being in use? I suppose I could try to kill it and catch the error if it is in use, but that also seems a bit crude, and file errors often seem to have poor performance/response times in my experience.

Thank you both for your time so far
May 24 '12 #6

NeoPa
Expert Mod 15k+
P: 31,276
That question relies on knowing if multiple users have their own front-ends. If so, then the very existence of the file means that the user has it open already. If not, then it becomes more complicated and some parsing of the LDB file data may be required.
May 25 '12 #7

ADezii
Expert 5K+
P: 8,607
Are you getting a non empty string value in sMyCaption? And what version of access are you using? I cant help but wonder if this is in someway related to me using Ac2010 and the code simply breaks in 2010.
Sorry, but I forgot to mention that I am using Access 2002. I'm sending you my Demo Version for the Definitive Test. Open a 2nd Instance of the Demo, then click the Command Button - the Code should work fine.
Attached Files
File Type: zip Multiple Instances.zip (16.1 KB, 114 views)
May 25 '12 #8

Post your reply

Sign in to post your reply or Sign up for a free account.