[AccessD] Number of Users

Dan:

Just drop it in and it works?  I try to avoid code when I don't understand
everything it's doing.  Can't maintain it.  Pretty much set a reference to
ADO and then plug and play?

Rocky





 	
	

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Dan Waters
Sent: Sunday, January 06, 2008 10:45 AM
To: 'Access Developers discussion and problem solving'
Subject: Re: [AccessD] Number of Users

Hi Rocky,

This came from MS KB198755, and I've used it for a few years now with no
problems.  This will also tell the person being kicked off who else is
logged in so they know who to ask to log off.

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

Public Sub UserLimit()
    
    Dim con As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim stgData As String
    Dim stg As String
    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}")
    
    Do While rst.EOF = False
        stgUserName = Left$(rst(1), InStr(1, rst(1), Chr(0)) - 1)
        Set rstFullname = DBEngine(0)(0).OpenRecordset("SELECT Person FROM
tblPeopleMain" _
            & " WHERE UserName = '" & stgUserName & "'", dbOpenSnapshot)
        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
    
    '-- Look for too many users logging in
    stgUsers = "SELECT ThisMonthUsers FROM tblUserLicenseInformation"
    Set rstUsers = DBEngine(0)(0).OpenRecordset(stgUsers, dbOpenSnapshot)
    If intUsers > rstUsers("ThisMonthUsers") Then
        stgLockout = "SELECT * FROM tblUserLicenseLockouts"
        Set rstLockout = DBEngine(0)(0).OpenRecordset(stgLockout,
dbOpenDynaset)
        rstLockout.AddNew
        rstLockout("Name") = CurrentPerson
        rstLockout("LockoutDate") = CurrentDate
        rstLockout("LockoutTime") = Format(Now(), "Medium Time")
        rstLockout("AllowedUsers") = rstUsers("ThisMonthUsers")
        rstLockout.Update
        rstLockout.Close
        Set rstLockout = Nothing
        FormattedMsgBox GstgNotReady, "There are insufficient User Licenses
for you to log on." _
            & "  The following people are now logged on to " & SystemTitle &
":" _
            & vbNewLine & vbNewLine _
            & stgNameList & "@ @", vbExclamation + vbOKOnly, "Insufficient
User Licenses"
        rstUsers.Close
        Set rstUsers = Nothing
        DoEvents
        DoCmd.Quit
        Exit Sub
    End If
    rstUsers.Close
    Set rstUsers = Nothing

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: Sunday, January 06, 2008 10:19 AM
To: 'Access Developers discussion and problem solving'
Subject: [AccessD] Number of Users

Dear List:
 
What is the easiest way to restrict the number of users in a FE/BE
application?
 
MTIA
 
Rocky
 
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com

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

No virus found in this incoming message.
Checked by AVG Free Edition. 
Version: 7.5.516 / Virus Database: 269.17.13/1210 - Release Date: 1/5/2008
11:46 AM