[AccessD] FW: Multi User Access question

Hi Rocky - this is my procedure.  You'll need to tweak it for yourself.  

A System Owner is a role that I've defined, and you probably won't want to
use that part.  

Good Luck!

--------------------------------

' C Copyright ProMation Systems, Inc.
' Procedure : CheckUserLicenseLimit
' DateTime  : 8/24/2007 10:12
' Author    : Dan Waters
' Purpose   : Prevent too many users from loggin in.  A single System Owner
can log in past the upper limit.
  
Public Sub CheckUserLicenseLimitX()
On Error GoTo EH
    
    Dim con As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim stgFullName As String
    Dim rstFullname As DAO.Recordset
    Dim stgUserName As String
    Dim stgNameList As String
    Dim intUsers As Integer
    Dim stgUsers As String
    Dim rstUsers As DAO.Recordset
    Dim stgLockout As String
    Dim rstLockout As DAO.Recordset

    '-- The user roster is exposed as a provider-specific schema rowset _
        in the Jet 4.0 OLE DB provider.  You have to use a GUID to _
        reference the schema, as provider-specific schemas are not _
        listed in ADO's type library for schema rowsets

    '-- This is from MSKB 198755 and is specific to Access 2000 & up
    con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
DBEngine.SystemDB

    Set rst = con.OpenSchema(adSchemaProviderSpecific, ,
"{947bb102-5d43-11d1-bdbf-00c04fb92675}")
    
    '-- Count the number of currently logged in users
    Do While rst.EOF = False
        stgUserName = Left$(rst(1), InStr(1, rst(1), Chr(0)) - 1)
        stgFullName = "SELECT Person FROM tblPeopleMain" _
            & " WHERE UserName = '" & stgUserName & "'"
        Set rstFullname = CodeDb.OpenRecordset(stgFullName, dbOpenDynaset,
dbSeeChanges, dbReadOnly)
        If stgUserName <> "Admin" Then
            If stgNameList = "" Then
                stgNameList = rstFullname("Person")
            Else
                stgNameList = rstFullname("Person") & ", " & vbNewLine &
stgNameList
            End If
            intUsers = intUsers + 1
        End If
        rst.MoveNext
        rstFullname.Close
        Set rstFullname = Nothing
    Loop
    rst.Close
    Set rst = Nothing
    
    '-- If the person logging in is a System Owner, then allow one of them
to log in even if the limit has been reached.
    If CurrentJobRole("System Owner") = True Then
        intUsers = intUsers - 1
    End If
    
    '-- Look for too many users logging in
    stgUsers = "SELECT ThisMonthUsers FROM tblUserLicenseInformation" _
        & " WHERE BusinessGroup = '" & BusinessGroupCurrentPerson & "'"
    Set rstUsers = CodeDb.OpenRecordset(stgUsers, dbOpenSnapshot)
    If intUsers >= rstUsers("ThisMonthUsers") Then
        stgLockout = "SELECT * FROM tblUserLicenseLockouts"
        Set rstLockout = CodeDb.OpenRecordset(stgLockout, dbOpenDynaset,
dbSeeChanges)
        rstLockout.AddNew
        rstLockout("Name") = CurrentPerson
        rstLockout("LockoutDate") = CurrentDate
        rstLockout("LockoutTime") = Format(Now(), "Medium Time")
        rstLockout("AllowedUsers") = rstUsers("ThisMonthUsers")
        rstLockout("BusinessGroup") = rstUsers(BusinessGroupCurrentPerson)
        rstLockout.Update
        rstLockout.Close
        Set rstLockout = Nothing
        MsgBox "There are insufficient User Licenses for you to log on." _
            & "  The following people are now logged on to " & SystemAcronym
& ":" _
            & vbNewLine & vbNewLine _
            & stgNameList & "@ @", vbExclamation + vbOKOnly, "Insufficient
User Licenses"
        rstUsers.Close
        Set rstUsers = Nothing
        DoCmd.Quit
        Exit Sub
    End If
    
    rstUsers.Close
    Set rstUsers = Nothing

    Exit Sub
    
EH:

End Sub
-------------------------------------

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Rocky Smolin at
Beach Access Software
Sent: Tuesday, November 04, 2008 8:59 AM
To: 'Access Developers discussion and problem solving'
Subject: [AccessD] FW: Multi User Access question

 
Dear List:

Does anyone know the answer to Dixon's question below?

TIA,

Rocky Smolin
Beach Access Software
858-259-4334
www.e-z-mrp.com
www.bchacc.com
 
 

-----Original Message-----
From: Dixon [mailto:dixon at fossware.net] 
Sent: Tuesday, November 04, 2008 6:46 AM
To: Doug_Murphy; Rocky_Smolin
Subject: Multi User Access question

Guys,

I have a client who wants to limit the number of simultaneous users. Any
thoughts on how to approach this?

  
Dixon
dixon at fossware.net
2008-11-04


-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com