Send message to logged on user

[angusfreefa]

Dear all,

This is my first post in BYTES.
I am new to Access VBA. I am currently doing a database which serve as a central warehouse for 2 properties. The database is put on the company network so that users from different properties can access in the same time.
I have already having a code for checking who is logged on the database using ADODB, which works fine.

Here come to the problem, how can I send individual message to the logged on users? Something like an instant message between 2 users. I tried to look in the forum and I did found a post which posted in 2006 and have a suggestion. But now the link in that post was damaged and could not open any more.

Much appriciated if anyone could give me some hints, thanks for your kindness in advance.

Angus L.

[NeoPa]

If you post the link to the old thread you found I'll see if I can fix the link. Otherwise, it's very hard to work from a thread we cannot see.

[NeoPa]

Until then, I would say that Access is not well suited to such an IM system. The best I can think of would be to have a table which held such messages. You would need to implement an interface - using a form - that allowed you to post such a message to a user. You would also need a system whereby a logged on user could have the message show whenever one appeared. For this I would consider a polling mechanism, driven by the timer, which periodically checked the contents of the table. When one was found relevant to the currently logged on user it would be displayed in a form.

Welcome to Bytes!

[ADezii]

@angusfreefa
NeoPa pretty much hit the nail on the head with this one, I'll just try to assist.

There is a mechanism by which you can Send 'Pseudo' Instant Messages to other Users in a Multi-User environment without using E-Mail. This system involves a Table, Form, Timer() Event, and the use of a Table in a Shared Database to which all Users have access. This Table facilitates and contains data relating to the transference of Messages. When I get a chance, I'll simply the system and send it to you as an Attachment with instructions.

[angusfreefa]

@NeoPa
Thanks NeoPa,
The thread is as below:

http://bytes.com/topic/access/answer...ge-logged-user

I saw you at the post also, haha

Cheers

[angusfreefa]

@ADezii
Thanks ADezii,

I got a question, how can the system identify who would be the receiver of the message? I am not expecting when i post a message in a Form, with a timer, Everone logged on would see the mesasage.

If you have have anything which likely to have similar function, You are welcome to send to my E-Mail: ** removed as per site rules **.

Thanks.

[ADezii]

@angusfreefa

I got a question, how can the system identify who would be the receiver of the message?

1. A To Combo Box on a Send E-Mail Form is populated with a list of all currently Logged-On Users using a List Filling Callback Function. The Sender is automatically assigned as CurrentUser(), select a Recipient from the To Combo Box, then just enter the Message Text. A Shared Table on the Back End is populated with the following information:
   • MessageID
   • From
   • To
   • Date Sent
   • Date Received
   • Message
2. I'm sure that the code could be modified to return only the latest Message designated for a specific User, namely the CurrentUser() on each FE.
3. If you are sincerely interested, I'll try to modify the code to make it work under your circumstances, but if not, please do not let me spent time on this Project. Let me know either way.

[NeoPa]

@angusfreefa
Angus,

Feel free to swap contact details, but using the Private Message system for this rather than the public forum. This particular rule is mainly for your own protection.

Administrator.

[NeoPa]

@angusfreefa
You could use the LDB file to return the PC names of all logged-on users. Messages (using NET SEND) could be sent to the PC name.

Bear in mind this message would depend on the Messaging Service running on the recipient PC. It would not be received within the Access application (It would pop-up on the screen).

[angusfreefa]

If you are sincerely interested, I'll try to modify the code to make it work under your circumstances, but if not, please do not let me spent time on this Project. Let me know either way.

Hi ADezii,
I am sincerely interested. I tried to make a Form for sending message, still I am not sure how to send to particular receiver. So now the code would show a pop-up form which all logged-on users can see the message.

Below is how I set up the Message sending Form.
A Form with a listbox, a textbox, a timer and a commandd button. User type message in the textbox, then the message saved in a table. the content in the table will be load to the listbox. Timer is set to refresh the list box every 5 seconds. This works, but there is no privacy as everyone can see the message.

Private Sub Form_Load()
 
    Me.txtuserbase = strUserbase  ' shows where is the working property
    Me.txtCurrentUser = strCurrentUserName 'shows the user name
 
End Sub
 
Private Sub Send_Click()
If Me.message = Null Then
 
MsgBox " Can't send blank message"
 
Else
' to save the message to a table called message_history
Set rs = New ADODB.Recordset
    StrTemp = "Select * From message_history" 
    rs.Open StrTemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
 
                rs.AddNew
                rs("sender") = Me![txtCurrentUser]
                rs("message") = Me![message]
                rs("time") = Now
                rs("receiver") = ""
                rs.Update
                rs.close
    Set rs = Nothing
 
    Me.message = Null
    Me.message.SetFocus
    history.Requery
End If
End Sub
 
'timer to load and refresh data in the listbox
Private Sub Form_Timer()
history.Requery
Dim sList As String
Set myrs = New ADODB.Recordset
    StrTemp = "Select * From message_history"
    myrs.Open StrTemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
 
While Not myrs.EOF
sList = sList & myrs(0) & ";" & myrs(1) & ";"
myrs.MoveNext
Wend
history.RowSource = sList
myrs.close
Set myrs = Nothing
End Sub

[angusfreefa]

Also, the below code is from somewhere in Internet which i used for tracking who is logging-on the database and it work well.

Function ShowUserRosterMultipleUsersLocal()
 
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim Rst As DAO.Recordset
 
    Dim i, j As Long
    Dim StrComp As String
    Dim StrUser As String
    StrWhereAmI = CurrentProject.Path
 
 
        Set cn = CurrentProject.Connection
    Set Rst = CurrentDb.OpenRecordset("TblSession")
    ' 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
 
    Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
    , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * From TblSession"
 
    While Not rs.EOF
       Rst.AddNew
       Rst.Fields(0) = rs.Fields(0)
       Rst.Fields(1) = rs.Fields(1)
       Rst.Fields(2) = rs.Fields(2)
       Rst.Update
 
 
 
        rs.MoveNext
    Wend
DoCmd.SetWarnings True
Set Rst = Nothing
DoEvents
Me.List0.RowSource = "QryCurrentUsers"
End Function
Function ShowUserRosterMultipleUsersRemote()
 
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim Rst As DAO.Recordset
 
    Dim i, j As Long
    Dim StrComp As String
    Dim StrUser As String
    StrWhereAmI = Me.TxtPath
 
    Set Rst = CurrentDb.OpenRecordset("TblSession")
    With cn
      .Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
         "Data Source=" & Me.TxtPath & "\" & Me.TxtFile
 
    ' 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
 
    Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
    , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
    DoCmd.SetWarnings False
    DoCmd.RunSQL "Delete * From TblSession"
 
        While Not rs.EOF
           Rst.AddNew
           Rst.Fields(0) = rs.Fields(0)
           Rst.Fields(1) = rs.Fields(1)
           Rst.Fields(2) = rs.Fields(2)
           Rst.Update
 
 
 
            rs.MoveNext
        Wend
    DoCmd.SetWarnings True
    Set Rst = Nothing
    End With
DoEvents
Me.List0.RowSource = "QryCurrentUsers"
End Function
 
 
Private Sub CmdBrowse_Click()
Dim LastSlash As Integer
 
    Me.CmDlg.InitDir = CurrentProject.Path
    Me.CmDlg.Filter = "Microsoft Access Database (*.mdb)|*.mdb"
 
    Me.CmDlg.ShowOpen
    Me.TxtPath = Me.CmDlg.FileName
    LastSlash = InStrRev(Me.CmDlg.FileName, "\")
 
    Me.TxtPath = Left(Me.CmDlg.FileName, LastSlash - 1)
 
    Me.TxtFile = Mid(Me.CmDlg.FileName, LastSlash + 1)
 
End Sub
 
Private Sub CmdLock_Click()
If Me.CmdLock.Caption = "Lock Database" Then
    Dim strMsg As String
    If Nz(Me.TxtFile, "") = "" Then
        StrWhereAmI = CurrentProject.Path
    Else
        StrWhereAmI = Me.TxtPath
    End If
 
    strMsg = InputBox("What message do you want to show the user?", "System Down Message")
    If strMsg = "" Then
        Exit Sub
    End If
    Open StrWhereAmI & "\Locked.Txt" For Output As #1
    Print #1, strMsg
    Close #1
 
    Me.CmdLock.Caption = "Unlock Database"
Else
    If Dir(StrWhereAmI & "\Locked.Txt") <> "" Then
        Kill StrWhereAmI & "\Locked.Txt"
    End If
    Me.CmdLock.Caption = "Lock Database"
End If
 
 
 
End Sub
 
Private Sub CmdReset_Click()
    Me.TxtPath = ""
    Me.TxtFile = ""
    Me.List0.RowSource = ""
    Me.List0.Requery
 
End Sub
 
Private Sub CmdRetry_Click()
Me.List0.RowSource = ""
Me.List0.Requery
 
    If Nz(Me.TxtFile, "") = "" Then
        Call ShowUserRosterMultipleUsersLocal
    Else
        Call ShowUserRosterMultipleUsersRemote
    End If
End Sub
 
Private Sub CmdClose_Click()
On Error GoTo Err_CmdClose_Click
 
 
    DoCmd.Close
 
Exit_CmdClose_Click:
    Exit Sub
 
Err_CmdClose_Click:
    MsgBox Err.Description
    Resume Exit_CmdClose_Click
 
End Sub
 
Public Function FindComputerName()
    Dim strBuffer As String
    Dim lngSize As Long
 
    strBuffer = String(100, " ")
    lngSize = Len(strBuffer)
 
    If GetComputerName(strBuffer, lngSize) = 1 Then
        FindComputerName = Left(strBuffer, lngSize)
    Else
        FindComputerName = "Computer Name not available"
    End If
 
End Function
 
Private Sub Form_Load()
'Call LockedOut
End Sub
 
Private Sub List0_Click()
    Me.CmdSend.Enabled = True
    Me.CmdDisconnect.Enabled = True
End Sub

[angusfreefa]

@NeoPa
I will be aware of this next time. Thanks NeoPa.

[NeoPa]

That looks like some interesting code Angus. I think I'll make a note of the link for re-use later. If you know the original source I'd be interested to see that too.

PS. Don't forget the tags for code. Tags are done as matching pairs where the opening one is surrounded by [...] and the closing one by [/...]. A set of buttons is available for ease of use in the Standard Editor (Not the Basic Editor). The one for the [ CODE ] tags has a hash (#) on it. You can choose which editor to use in your Profile Options (Look near the bottom of the page).

[angusfreefa]

Any one got any suggestion? thanks

[ADezii]

@angusfreefa
I can E-Mail you the entire System, along with Instructions, straight from the Access Cookbook. Because of Attachment restrictions, the Files will be too large to Attach to this Forum. If you are interested, give me your E-Mail Address in a Private Message and I'll send it to you as soon as I get a chance.

[ADezii]

I've reduced the code to its simplest state for ease of use, but left the original code in tact for your reference. The Attachment contains 2 Databases (Front and Back End) which you will need.

1. Copy both Databases to the Root Directory of Drive C: (C:\) for an initial Demo since the Path to the Back End has already been set.
2. Open the Front End Database (EMail_FE.mdb). The AutoExec Macro contained within will open frmReceiveMail and position it in the Upper Left Corner of the Screen. It also will open frmSendMail and Center it on Screen.
3. Send yourself an E-Mail by utilizing the To Drop Down Combo and a short message.
4. In 10 seconds, the E-Mail to yourself will be shown in frmReceiveMail.
5. Click the Mark as Read Command Button to acknowledge, and clear frmReceiveMail. I think you'll get the idea from this point on.
6. ALL Front End Databases (EMail_FE.mdb) must be Linked to tblMessage in the Back End Database (EMail_BE.mdb) and have Full Permissions on this Table. This Table contains all E-Mail related information.
7. You can modify the time that it takes to receive New Mail by changing the TimerInterval Property on frmReceiveMail (currently set to 10000 or 10 seconds).
8. Have fun, and if you have any questions, feel free to ask.