Who is Online
As we already knew we can install Access Database on a Local Area Network (LAN) and several Users can work on it at the same time. But it is difficult to know how many users are actually online with the Application at a given time.
Similarly, when there are several MS-Access Databases on a Network under a centrally controlled Security Workgroup it will be interesting to know which users are currently working on the MS-Access Applications on the Network.
You don’t need any complicated programs to find this out. When someone opens a Database, say NorthWind.mdb, MS-Access opens a Lock-File with the same name of the Database with file extension .ldb (Northwind.ldb) in the same folder of the Database. You can open this file with Notepad or any other Text Editor and view the contents.
This file contains the Workstation Ids and MS-Access User IDs of all the active Users of the Database. The lock file will be deleted by MS-Access when all the Users close the database. In other words if a Lock File is not active then nobody is currently using the database.
We can implement MS-Access Security of several Databases with a common Workgroup File in a Network holding Workgroup IDs, User IDs and User Passwords. In such situations there will be a common Workgroup File (a Database with .MDW extension) accessible to all the Users in a Network. When someone Log-in into the Workgroup to open a database, a lock-file with .ldb extension will open up with the same name of the Workgroup file. This file will contain the Workstation IDs and User IDs of all the Users currently active across different databases.
We will design a Form and write Programs to open the Lock-File of a Database or Workgroup File and display the List of Workstation IDs and User IDs currently active. In addition to that we will try to send messages through Network to the selected Users from this list.
- Design a Form similar to the one shown below and change the Properties of the Controls as explained. Smaller controls are Text Boxes and the big Control under the label Users Online is a List Box.
- Click on the Text Box below the label: Workgroup or Database File Path and display the property sheet. Change the value of the Name Property to FPath.
- Display the Property Sheet of the List Box and change the value of the following properties as given below:
- Name = UsrList
- Row Source Type = Value List
- Column Count = 2
- Column Heads = No
- Column Width = 1.25";1.25"
- Bound Column = 1
- Multi Select = simple
- Display the property sheet of the Text Box above the Send Message Button and change the value of the Name Property to msgtxt.
- Display the Property Sheet of the Button with the caption < and change the value of the Name Property to cmdUpdate.
- Display the Property Sheet of the Button with the Caption Send Message and change the value of the Name property to cmdNS.
- Save the Form with the name; whoisonline.
NB: We are referencing all the above Property Values in Programs and it is important that you change the Values of respective controls as explained above.
Copy and Paste the following Code into the VB Module (Select Tools > Macro > Visual Basic Editor to display the VB Module) of the whoisonline Form, Save and Close the Form.
NB: PROGRAM BUG FIXED.
Private Sub cmdNS_Click() '------------------------------------------------------- 'Author: a.p.r. pillai 'Date : 01/12/2007 '------------------------------------------------------- Dim ctl As ListBox, msg As String, usrs As String Dim i As Integer, pcs() As String, xmsg As String Dim ic As Integer, j As Integer, lc As Integer On Error GoTo cmdNS_Click_Err xmsg = Nz(Me.msgtxt, "") If Len(xmsg) = 0 Then MsgBox "Message Control is Empty.", , "cmdNS_Click()" Exit Sub End If Set ctl = Me.UsrList lc = ctl.listcount ic = ctl.ItemsSelected.Count If ic > 0 Then ReDim pcs(1 To ic, 1 To 2) i = 0 For j = 0 To lc - 1 If ctl.Selected(j) Then i = i + 1 pcs(i, 1) = ctl.Column(0, j) pcs(i, 2) = ctl.Column(1, j) End If Next usrs = "" For j = 1 To i msg = "NET SEND " & pcs(j, 1) & " User: " & pcs(j, 2) & " " & xmsg Call Shell(msg) If Len(usrs) = 0 Then usrs = j & ". WorkStationID: " & pcs(j, 1) & " UserID: " & pcs(j, 2) Else usrs = usrs & vbCr & j & ". WorkStationID: " & pcs(j, 1) & " UserID: " & pcs(j,2) End If Next MsgBox "Messages Sent to:" & vbCr & vbCr & usrs & vbCr & vbCr & "successfully.", , "cmdNS_Click()" Else MsgBox "Select one or more Users in list and try again.", , "cmdNS_Click()" End If cmdNS_Click_Exit: Exit Sub cmdNS_Click_Err: MsgBox Err.Description, , "cmdNS_Click()" Resume cmdNS_Click_Exit End Sub Private Sub cmdUpdate_Click() Me.UsrList.SetFocus Me.cmdUpdate.Enabled = False WhoisOnline Me.FPath Me.cmdUpdate.Enabled = True End Sub
- Copy and Paste the following VB Code into a Global Module in your Project and save:
Public Function WhoisOnline(ByVal strPathName) '------------------------------------------------------- 'Author : a.p.r. pillai 'Date : 01/12/2007 '------------------------------------------------------- Dim strldb() As String, j As Integer, strpath As String Dim str As String, intlen As Integer, t As Date Dim pos As Integer, xsize As Integer, l As Integer Dim FRM As Form, ctl As ListBox, qt As String Dim x As String Const strlen As Integer = 62 On Error Resume Next qt = Chr$(34) strpath = Trim(Nz(strPathName, "")) If Len(strpath) = 0 Then MsgBox "File Path is Empty.", , "WhoisOnline()" Exit Function End If str = Right(strpath, 4) l = InStr(1, ".mdb.mdw.ldb", str) Select Case l Case 0 strpath = strpath & ".ldb" Case 1, 5 strpath = Left(strpath, Len(strpath) - 4) & ".ldb" Case 9 'it is .ldb no action End Select Set FRM = Forms("WhoisOnline") Set ctl = FRM.Controls("UsrList") Open "c:\x.bat" For Output As #1 Print #1, "@Echo off" Print #1, "copy " & strpath & " c:\xx.txt" Close #1 Call Shell("c:\x.bat", vbHide) x = Dir("c:\xx.txt")t = Timer Do While Len(x) = 0 And Timer < (t + 2) x = Dir("c:\xx.txt") Loop t = Timer Do While Timer < (t + 2) 'do nothingLoop Open "c:\xx.txt" For Input As #1 If Err > 0 Then 'Lock file copying was not successfull MsgBox "Database is idle.", , "WhoisOnline()" Exit Function End If Input #1, str Close #1 intlen = Int(Len(str) / strlen) + 1 ReDim strldb(1 To intlen, 1 To 2) As String xsize = strlen / 2 For j = 1 To intlen pos = IIf(j = 1, 1, (j - 1) * strlen + 1) strldb(j, 1) = Trim(Mid(str, pos, xsize)) pos = pos + strlen / 2 strldb(j, 2) = Trim(Mid(str, pos, xsize)) Next str = "" For j = 1 To intlen If Len(str) = 0 Then str = qt & Trim(strldb(j, 1)) & qt & ";" & qt & Trim(strldb(j, 2)) & qt Else str = str & ";" & qt & Trim(strldb(j, 1)) & qt & ";" & qt & Trim(strldb(j, 2)) & qt End If Next ctl.RowSource = strctl.Requery Kill "c:\x.bat" Kill "c:\xx.txt" End Function
In the above program we are creating a DOS Batch File (c:\x.bat) and running it, to make a copy of the Lock-File c:\xx.txt as a work file.
- Open the whoisonline Form in Normal View. Type the full path of an active database (Tip: give the Path and Name of the Database you are currently working on, if you are not on a Network). If you are on a Network and have a common MS-Access Workgroup File, which other Users are currently connected then give that File's Path and Name. No need to give File Name extensions .mdb, .mdw or .ldb, but if you wish to include you may do so for clarity.
- Click on the Button with < symbol.
- Select one or two Workstation IDs in the List Box.
- Type a Message in the Text Box Control above the Send Message Button for the selected Users.
- Click on the Send Message Button. The Message Text will pop up on the selected Users' Machines.
NB: If you have selected your own machine name then the Send Message action will not work.