Results 1 to 4 of 4
  1. #1
    focosi is offline Advanced Beginner
    Windows XP Access 2010 32bit
    Join Date
    Jul 2011
    Posts
    97

    internal messaging system for Access


    Hi,
    I have succesfully implemented a recipe from Access CookBook ... :

    http://icodeguru.com/database/access...10-sect-4.html

    ... allowing current user of a user-level secured database to send internal messages to another user.
    Since there is no way to select multiple items from comboboxes in Access, I would like to know how can I send the same message simultaneously to multiple users ?
    I have read somewhere that on the contrary listoboxes can be configured to support multiselect. Can someone modify the code for me shifting the combobox to a listbox ?
    Thx

  2. #2
    pbaldy's Avatar
    pbaldy is offline Who is John Galt?
    Windows XP Access 2007
    Join Date
    Feb 2010
    Location
    Nevada, USA
    Posts
    22,518
    I got tired of waiting for that to load, so I never saw their code. Here is the basic loop used to get the selections from a multi-select listbox. You should be able to wrap that around the code used to send a message.

    http://www.baldyweb.com/MultiselectAppend.htm
    Paul (wino moderator)
    MS Access MVP 2007-2019
    www.BaldyWeb.com

  3. #3
    focosi is offline Advanced Beginner
    Windows XP Access 2010 32bit
    Join Date
    Jul 2011
    Posts
    97
    The function that lists all users is

    Option Compare Database
    Option Explicit
    Private mastrUsers() As String
    Private mintTotalUsers As Integer
    Function acbFillUserList(ctl As Control, varID As Variant, _
    varRow As Variant, varCol As Variant, varCode As Variant) _
    As Variant
    ' List filling function for users.
    Dim varRetVal As Variant
    varRetVal = Null

    Select Case varCode
    Case acLBInitialize
    mintTotalUsers = GetUserArray()
    varRetVal = True
    Case acLBOpen
    varRetVal = Timer
    Case acLBGetRowCount
    varRetVal = mintTotalUsers
    Case acLBGetValue
    varRetVal = mastrUsers(varRow)
    End Select
    acbFillUserList = varRetVal
    End Function
    Private Function GetUserArray() As Integer
    ' Fills mmastrUsers() with a list
    ' of user account names.
    ' Returns the total number of accounts.
    Dim intI As Integer
    Dim intUser As Integer
    Dim intTotalUser As Integer
    Dim wrk As Workspace
    Dim strUser As String
    ' There are two "special" (for internal use) accounts
    ' which you can't actually use (Engine and Creator),
    ' so we've eliminated them from consideration
    Const acbcNumSpecialAccnts = 2
    Set wrk = DBEngine.Workspaces(0)
    wrk.Users.Refresh

    ' Total count of users including
    ' the two special accounts
    intTotalUser = wrk.Users.Count

    ' Don't include the special accounts
    ' when dimensioning the array
    ReDim mastrUsers(intTotalUser - acbcNumSpecialAccnts)
    intUser = 0

    ' Interate through all accounts,
    ' adding an account if it is not
    ' one of the special accounts
    For intI = 0 To intTotalUser - 1
    strUser = wrk.Users(intI).Name
    ' You might wish to also eliminate the built-in "Admin"
    ' account. If so, add it to the following If...Then
    ' expression and bump up acbcNumSpecialAccnts to 3.
    If strUser <> "Engine" And strUser <> "Creator" Then
    mastrUsers(intUser) = strUser
    intUser = intUser + 1
    End If
    Next intI

    ' Return the total number of non-special accounts
    GetUserArray = intTotalUser - acbcNumSpecialAccnts
    End Function
    And here's the module that contains the functions :

    Option Compare Database
    Option Explicit
    Declare Function acb_apiIsIconic Lib "user32" _
    Alias "IsIconic" (ByVal hwnd As Long) As Long
    Function acbCheckMail() As Integer
    ' Check for new mail, and if there is any,
    ' restore the received mail form
    On Error GoTo HandleErr
    Dim rstClone As DAO.Recordset
    Dim frmMail As Form
    Set frmMail = Forms![frmReceiveMail]
    frmMail.Requery
    Set rstClone = frmMail.RecordsetClone
    rstClone.MoveFirst
    If Not rstClone.EOF Then
    frmMail.Caption = "Hai nuovi messaggi!"
    If acb_apiIsIconic(frmMail.hwnd) Then
    frmMail.SetFocus
    DoCmd.Restore
    End If
    Else
    frmMail.Caption = "Non hai nuovi messaggi : iconizza la finestra."
    DoCmd.Minimize
    End If

    rstClone.Close

    ExitHere:
    Exit Function

    HandleErr:
    Select Case err.Number
    Case 3021 ' no current record, do nothing
    Case Else
    MsgBox err & ": " & err.Description, , "acbCheckMail()"
    End Select
    Resume ExitHere
    End Function

    Function acbReceiveMail() As Integer

    ' Mark the currently-displayed
    ' message as received

    On Error GoTo HandleErr

    Dim frmMail As Form
    Dim rstClone As DAO.Recordset

    Set frmMail = Forms![frmReceiveMail]
    frmMail![DateReceived] = Now
    frmMail.Requery

    Set rstClone = frmMail.RecordsetClone
    If rstClone.RecordCount = 0 Then
    frmMail.Caption = "Non hai nuovi messaggi : iconizza la finestra."
    frmMail.SetFocus
    DoCmd.Minimize
    End If

    ExitHere:
    Exit Function

    HandleErr:
    MsgBox err & ": " & err.Description, , "acbReceiveMail()"
    Resume ExitHere
    End Function

    Function acbSendMail() As Integer

    ' Take the message and user from the
    ' frmMailSend form and send it to the mail
    ' backend

    On Error GoTo HandleErr

    Dim db As DAO.Database
    Dim rstMail As DAO.Recordset
    Dim frmMail As Form

    Set db = CurrentDb()
    Set rstMail = db.OpenRecordset( _
    "tblMessage", dbOpenDynaset, dbAppendOnly)
    Set frmMail = Forms![frmSendMail]

    With rstMail
    .AddNew
    ![From] = CurrentUser()
    ![To] = frmMail![cboTo]
    ![DateSent] = Now
    ![Message] = frmMail![txtMessage]
    .Update
    End With

    frmMail![cboTo] = Null
    frmMail![txtMessage] = Null

    rstMail.Close

    ExitHere:
    Exit Function

    HandleErr:
    MsgBox err & ": " & err.Description, , "acbSendMail()"
    Resume ExitHere
    End Function
    As previously said the form "frmSendMail" contains a "cboTo" combobox whose row source is :

    acbFillUserList

    I have already tried to change the combobox into a listbox and add the function you gave me in previous post, but the debugger highlights this line... :

    varRetVal = mastrUsers(varRow)

    ... within the acbFillUserList function....
    Paul, could you please help me ?? Thx!
    Last edited by focosi; 08-12-2011 at 02:44 AM.

  4. #4
    pbaldy's Avatar
    pbaldy is offline Who is John Galt?
    Windows XP Access 2007
    Join Date
    Feb 2010
    Location
    Nevada, USA
    Posts
    22,518
    How are you coming with this? This appears to be the line getting the value from the combo:

    ![To] = frmMail![cboTo]

    in acbSendMail. In that area is where you would incorporate the listbox code.
    Paul (wino moderator)
    MS Access MVP 2007-2019
    www.BaldyWeb.com

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Custom Access system VS QB
    By Gilligan in forum Access
    Replies: 3
    Last Post: 08-05-2011, 08:25 PM
  2. Replies: 2
    Last Post: 04-12-2011, 10:14 AM
  3. SYSTEM.MDW MS Access 2007.
    By SIGMA248 in forum Access
    Replies: 2
    Last Post: 03-21-2011, 05:52 AM
  4. New access user -- help in creating a sub system
    By fidget_sane in forum Access
    Replies: 20
    Last Post: 04-22-2010, 11:46 AM
  5. Replies: 0
    Last Post: 03-04-2010, 06:32 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums