Introduction.
We already know that 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 to the Workgroup to open a database, a lock file with the ldb extension will open up with the same name as 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 the Network to the selected Users from this list.
Designing a WhoIsOnline Form
- Design a Form similar to the one shown below and change the Properties of the Controls as explained. Smaller controls are TextBoxes 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 symbol < 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; whois online.
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 VBA Module (Select Tools > Macro > Visual Basic Editor to display the VBA Module) of the whois online Form, Save and Close the Form.
Form Class Module VBA Code
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
The Main Program
Copy and Paste the following VBA 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
NOTE: The above VBA Code was written for Windows XP and the NET SEND message Command is used for sending messages to a Workstation. Windows 10/08/7 uses the MSG Command. Type C:\MSG /? In the Command Prompt for full Parameter List and Options.
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.
The Demo Run
Open the Whois online 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, on which other users are currently connected, then give that File's PathName. 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.
Download Demo Database
Download Demo Who-is-online.zip
I get the following error:
ReplyDeleteInvalid use of property
at the following line
WhoisOnline Me.FPath
Hi,
ReplyDeleteIt is likely that the control name (where you need to enter the Workgroup or database path) you have given differently, instead of FPath. Check again. This can happen if you are using the reference Me.FPath in Global Module.
I made few changes in the Main Program. Copy and paste it in the Global Module and try it again. If you are not able to figure it out the problem Zip your Database with Winzip and forward it to me at aprpillai@msaccesstips.com. Let me have a look at it.
Or you can give me your e-mail address I will forward the sample Database to you.
Regards,
a.p.r. pillai
the database didn't work, it says that the "database is idle".
ReplyDeleteTry increasing the delay loop time. Change the following lines:
ReplyDeleteDo While Len(x) = 0 And Timer < (t + 5)
x = Dir("c:\xx.txt")
Loop
t = Timer
Do While Timer < (t + 5)
'do nothing
Loop
Change the t+2 expressions to t+5 or to t+10
Hi Mr Pillai,
ReplyDeleteI have done all of the above but i get the same error. "Increase the delay loop Value from 5 to 10 seconds and try again."
i got the code below and changed it to the t + 10 but it still don't work
x = ""
t = timer
Do While Len(x) = 0 And timer < (t + 10)
x = Dir("c:\xx.txt")
Loop
t = timer
Do While timer < (t + 10)
'do nothing
Loop
Open "c:\xx.txt" For Input As #1
If Err > 0 Then
'Lock file copying was not successfull
MsgBox "Database Lock File copy was not successful." _
& " Increase the delay loop Value from 5 to 10 seconds and try again.", , "WhoisOnline()"
Exit Function
What Version of Windows you are using?
ReplyDeleteTry changing the line that reads
Print #1, "copy " & strpath & " c:\xx.txt"
to
Print #1, "xcopy " & strpath & " c:\xx.txt"
Or try creating a folder c:\tmp and change the location addresses given in the code to read as c:\tmp\xx.txt and c:\tmp\x.bat
Perhaps, the Security Policy on your machine may not allow writing to root directory.
Thanks for the reply,
ReplyDeleteI am using windows xp and microsoft access 2000 version,
I tried to copy "Print #1, "xcopy " & strpath & " c:\xx.txt"
however it still didn't work.
My database will be shared with other users so i wanted this feature to work.
Replace the area of the Code with the following lines and retry:
ReplyDeleteSet FRM = Forms("WhoisOnline")
Set ctl = FRM.Controls("UsrList")
Open strpath For Input As #1
Open "C:\xx.txt" For Output As #2
Do While Not EOF(1)
Input #1, x
Print #2, x
Loop
Close #1
Close #2
t = Timer
Do While Timer < (t + 2)
'do nothing
Loop
The Code change is after the first two lines (you will find in the original code) and before the line that reads 1 = timer.
Need some correction to the above suggestion by implementing a validation check before executing that portion of code.
ReplyDeleteAdd the following Code between the lines End Select and Set FRM = Forms("WhoisOnline"):
Dim x As String, chk As String
chk = Dir(strpath)
If Len(chk) = 0 Then
MsgBox strpath & vbCr & "not found. Database may be idle."
Exit Function
End If
Hi thanks for the response,
ReplyDeleteI used the above code but i got an error for this part
Dim x As String,
so when i try to run the application but it shows an error of
"Duplicate declaration in current scope"
Hi mr pillai,
ReplyDeletei fixed the above problem but when i ran the application i still got the same message that database is idle,
i think the problem lies in the code below,
Thanks in advance
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
Hi mr Pillai,
ReplyDeletei got the application to finally work, but now i have another problem, when i select the user that i want to send the message to it doesn't show it on their computer,
What i have done is that I ran the "online" application on my pc, and database that i want to check on another PC, it showed that there was one user and their workstation Id, however it didn't send them a message, i also got the successful sent message popup, but the message didn't show on the other computer, one thing that might interest you is that the message was sent to Admin since they were the only person who had it open.
I am new to access so can you please help.
Thanks in Advance
Hi,
ReplyDeleteMS-Access UserID is not important here, but the WorkstationID is. The same problem was reported by another User of Windows 2000. Our Office Network is Windows2000 only and there is no problems so far for us here.
Check with your Administrator whether they have disabled the NET SEND Command through Login Script.
You can try sending a message directly to the WorkstationID after opening the DOS Window.
1. Select RUN from StartMenu
2. Type: cmd and Click OK to open DOS Shell.
3. Type: NET SEND workstationID HAPPY NEW YEAR 2009
4. Go to the other Workstation where you send the message and check.
Regards
Hi,
ReplyDeleteI have tried the above but i get an error.
"the message alias could not be found"
but the network id for that computer is correct so i don't know what the problem is.
Try sending a message to your own PC from DOS prompt using your machine's IP address or NetworkID. If it is successful you will see a message box with the text you sent. If not then there may be some problem with your Network. Check with your Network Administrator.
ReplyDeleteRegards,
Hi nice site.
ReplyDeleteIs the download for the who is online working?
I read what others are saying I got error same error datbase is idle. Using Windows XP-64bit access 2003 @ work.
ReplyDeleteOk I made some progress. In the users online screen the left side just says .mdb and the right is blank. Not sure why?
ReplyDeleteThis is a moot point if you're putting a database on a network where people can access it via some type of virtual server or host emulation setup. It's best to pull the username out of the user's registry rather than rely on the .ldb file.
ReplyDeletethe database didnt work, it says that the database is idle.
ReplyDeleteI did below but it say database is idle yet
My database is running but it just say that
a.p.r. pillai says: September 19, 2008 at 6:19 pm
Try increasing the delay loop time. Change the following lines:
Do While Len(x) = 0 And Timer < (t + 5)
x = Dir("c:\xx.txt")
Loop
t = Timer
Do While Timer < (t + 5)
'do nothing
Loop
Change the t+2 expressions to t+5 or to t+10
for mention i am using windows xp and access 2003
ReplyDeleteTry the following:
ReplyDelete1. After getting the error message, Open the windows explorer and check whether the file c:\xx.txt has been created there or not.
If it is created then try increasing the t+10 expression to a bigger number, because your machine may be faster in execution of VBA Code and it is attempting to access the text file not yet created under DOS.
2. Change the line that reads 'do nothing to Doevents within the delay loop.
3. If the file is not created change the text file's location to an inner folder like c:\tmp\xx.txt (after creating the folder tmp) and make this change wherever this file is referenced and try the program again.
Due to the access rights settings some machines may not allow to create files in the root directory.
This program is written under MS-Access2003 and XP only.
Regards,