Access Session Count 1

[rgbanse]

I need to restrict the number of access sessions on a group of scheduling machines. I can determine if at lease one session is running but not how many are running I need a way to determine the count.
thx
RGB

 

[Remou]

This may help:

Declare Function LDBUser_GetUsers Lib "MSLDBUSR.DLL" _
      (lpszUserBuffer() As String, ByVal lpszFilename As String, _
      ByVal nOptions As Long) As Integer

      Public Function GetUsers(Optional StrDbPath As String)

         ReDim lpszUserBuffer(1) As String
         Dim intLooper As Integer
         Dim Cusers As Long
         Dim strMsgBox As String

         On Error GoTo Err_GetUsers

         ' Check to see if a database path was passed
         ' to the function. If the argument was not used,
         ' assume that we're to investigate the .ldb
         ' of the current database.
         If IsMissing(StrDbPath) Or StrDbPath = "" Then
              StrDbPath = CurrentDb.Name
         End If

         ' Set Cusers to the number of computers currently connected
         ' to the database. Insert computer information into the
         ' lpszUserBuffer array.

         ' Arguments of LdbUser_Get Users:
         ' 1 =   All users who have logged in since the LDB file was
         ' created
         ' 2 =   Only users who are currently logged in
         ' 4 =   Only users who are causing the database file to be
         ' corrupted
         ' 8 =   Just return the count of users

         Cusers = LDBUser_GetUsers(lpszUserBuffer(), StrDbPath, 2)

         ' Print possible errors returned by the function.
         Select Case Cusers
              Case -1
                   strMsgBox = "Can't open the LDB file"
              Case -2
                   strMsgBox = "No user connected"
              Case -3
                   strMsgBox = "Can't Create an Array"
              Case -4
                   strMsgBox = "Can't redimension array"
              Case -5
                   strMsgBox = "Invalid argument passed"
              Case -6
                   strMsgBox = "Memory allocation error"
              Case -7
                   strMsgBox = "Bad index"
              Case -8
                   strMsgBox = "Out of memory"
              Case -9
                   strMsgBox = "Invalid Argument"
              Case -10
                   strMsgBox = "LDB is suspected as corrupted"
              Case -11
                   strMsgBox = "Invalid argument"
              Case -12
                   strMsgBox = "Unable to read MDB file"
              Case -13
                   strMsgBox = "Can't open the MDB file"
              Case -14
                   strMsgBox = "Can't find the LDB file"
         End Select

         If Not IsEmpty(strMsgBox) And strMsgBox <> "" Then
              MsgBox strMsgBox, vbCritical, "Error"
              Exit Function
         End If

         ' Print computer names to Debug window.
         For intLooper = 0 To Cusers - 1
              Debug.Print "User"; intLooper + 1; ":"; _
              lpszUserBuffer(intLooper)
         Next

Exit_GetUsers:
         Exit Function
Err_GetUsers:
         MsgBox Err.Description
         Resume Exit_GetUsers

End Function

 

[rgbanse]

having trouble with

Declare Function LDBUser_GetUsers Lib "MSLDBUSR.DLL" _
(lpszUserBuffer() As String, ByVal lpszFilename As String, _
ByVal nOptions As Long) As Integer

Compile Error:
Only comments may appear End Sub, End Function or End Property

 

[Remou]

The code should go in a module, just under

Option Compare Database
Option Explicit

 

[rgbanse]

this appears to be looking at the ldb file and would give me the number of users in a specific data base. I'm trying to find how many sessions of msaccess.exe are running on a give pc. I need to limit that number. Follows some code I use to limit to one seccession but I want to allow, say, 5 max open 'msaccess' programs at a time
thx

used in code (Sample)
Call RunUntilFinished ("C:\\Program Files\Common Files\MicrosoftShared\PhotoEd\PhotoEd.exe")

Private Sub RunUntilFinished(ByVal sApp As String)
Dim lProcID As Long
Dim hProc As Long
' Start the App
lProcID = Shell(sApp, vbHide)
DoEvents
' Wait for the App
hProc = OpenProcess(SYNCHRONIZE, 0, lProcID)
If hProc <> 0 Then
WaitForSingleObject hProc, INFINITE
CloseHandle hProc
End If
Exit Sub
End Sub

 

[Remou]

Ok, I did not quite get you. How about using something like:

'[URL unfurl="true"]http://msdn.microsoft.com/msdnmag/issues/0400/wmi/[/URL]
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_Process")
    If Process.Name = "MSACCESS.EXE" Then
        strCount = strCount+1
    End If
Next

Debug.Print strCount

 

[rgbanse]

Geez - has it been that long - answer is exactly what I was looking for.
thx and a star
RGB

 

[evalesthy]

Remou: I like the code - but wouldn't it return a count of 2 if two different Access apps are open?

 

[Remou]

evalesthy, I don't quite get your point, RGB asked for "open 'msaccess' programs".

 

[evalesthy]

Remove: My only thought was that maybe RGB wanted to know if more than one instance of the same app was open as opposed to how many Access instances total. Maybe he doesn't want two instances of the same app open but two different apps is OK. Then that led to my question of whether your routine would give him the net total but not whether two instances of the same app were open. Just my own curiosity that's all.

 

[Remou]

My previous post on the ldb file showed whether more than one instance of the same database was open, however, RGB wanted a count of instances of the Access programme (MSACCESS.EXE). I have some code somewhere that returns the titles of open windows, which would probably have suited if RGB had requested details of the databases open in the instances of MSAccess. There are just so many ways, it can be difficult to decide on the best method. All I can say is that it seemed to be what was required.

 

[evalesthy]

Thanks for the clarification - I think we are all on the same page now - maybe. Have a good weekend. PS - I always enjoy your posts - you are one of the top tipsters in my view.

 

[Southernx50]

I just get an error message stating File not found: MSLDBUSR.DLL

 

[Remou]

Have a look here:

http://support.microsoft.com/kb/176670

 

[Southernx50]

Thanks - thought I was missing something.