I have a form called frmSendMsgDialog which lists high priority defects in a listbox or, depending on an option control, allows the user to select 'Agenda' or 'Minutes' to automatically send out these messages to those individuals in the tblContacts table associated with the meetings. I'll provide the code behind the form and you will have to disassemble it. A 'Send' button is disabled until something is selected in the listbox.
Steve King
Option Compare Database
Const AGENDA As Integer = 1
Const MINUTES As Integer = 2
Const IMMEDIATE As Integer = 3
Const TRBLISTTRB As String = "SELECT [tblTRBSchedule].[TRBID], [tblTRBSchedule].[TRB_Date], " _
& "[tblTRBSchedule].[TRB_Time], [tblTRBSchedule].[Location], " _
& "[tblTRBSchedule].[DateAgendaMailed], [tblTRBSchedule].[DateMinutesMailed] " _
& "FROM [tblTRBSchedule] " _
& "WHERE (((tblTRBSchedule.IsComplete)=False));"
Const TRBLISTIMMEDIATE As String = "SELECT tblIncidentReports.IRNbr, tblIncidentReports.IRTitle, " _
& "tblIncidentReports.Pri, tblIncidentReports.OpenDate " _
& "FROM tblIncidentReports " _
& "WHERE (((tblIncidentReports.Pri) = 3)) " _
& "ORDER BY DecodeYear([IRNbr]) DESC , DecodeSequence([IRNbr]) DESC;"
Dim mstrSQL As String
Dim mstrCaption As String
' Get TRB Information
Dim mintTRBID As Integer
Dim mstrTRB_Date As String
Dim mstrTRB_Time As String
Dim mstrLocation As String
Dim mstrDateAgendaMailed As String
Dim mstrDateMinutesMailed As String
' Get IR Information
Dim mstrIRNbr As String
Dim mstrIRTitle As String
' Get Message Information
Dim mstrSubject As String
Dim mstrBody As String
Dim mstrSalutation As String
Dim mstrAddressee As String
Dim mstrMsgOut As String
' Object Declarations
Dim db As Database
Dim TRBSchedule_Rcd As Recordset
Dim TRBActivities_Rcd As Recordset
Dim TRBParticipant_Rcd As Recordset
Dim ConfigMgr_Rcd As Recordset
' True when a message has been selected
Dim mbMessageSelected As Boolean
Private Sub cmdCancel_Click()
DoCmd.Close
End Sub
Private Sub cmdSend_Click()
Dim bAgenda As Boolean
Dim bMinutes As Boolean
Dim bImmediate As Boolean
Dim strAddressee As String
Dim strBody As String
Dim strSaluation As String
Set db = CurrentDb
strAddressee = ""
strBody = ""
strSubject = ""
strSalutation = ""
bAgenda = False
bMinutes = False
On Error GoTo HandleErr
If Me.fraMsgType = 0 Then
MsgBox "You must select a message type and source prior to sending the message."
GoTo Exit_Proc
End If
Select Case Me.fraMsgType
Case AGENDA
strSubject = "Dominium TRB Agenda (" & mstrTRB_Date & " " _
& mstrTRB_Time & "

" & vbCrLf
'Getting the list of addressees for the message
' ***** AGENDA (ADDRESSEES) *****
strAddressees = GetAddressees(mintTRBID)
' ***** AGENDA (AGENDA ITEM STATUS) *****
'Getting the agenda items and comments
' Lead in text for the agenda items
strBody = strBody & "The following agenda items will be discussed at the TRB. " _
& vbCrLf & vbCrLf
strBody = strBody & GetAgendaItems(mintTRBID)
' ***** AGENDA (IR STATUS) *****
'Getting the scheduled IRs and status
' Lead in text for the incident reports
strBody = strBody & "The following Incident Reports will be reviewed at the " _
& "Technical Review Board:" & vbCrLf & vbCrLf
'Getting the status of IRs for this TRB
strBody = strBody & GetIRSchedule(mintTRBID)
' ***** MINUTES (ACTION ITEM) *****
'Getting the action items and status
' Lead in text for the incident reports
strBody = strBody & "The following action items are open for review during the TRB. " _
& vbCrLf & vbCrLf
'Getting the action item status from the TRB.
strBody = strBody & GetOpenActionItems()
' ***** MINUTES (SALUTATION) *****
'Getting the salutation
strBody = strBody & GetSalutation()
Case MINUTES
bMinutes = True
strSubject = "Dominium TRB Minutes (" & mstrTRB_Date & " " _
& mstrTRB_Time & "

" & vbCrLf
'Getting the list of addressees for the message
' ***** MINUTES (ADDRESSEES) *****
strAddressees = GetAddressees(mintTRBID)
' ***** MINUTES (PARTICIPANTS)
'Getting the participants for the TRB meeting
' Lead in text for the participants
strBody = strBody & "The following personnel attended the TRB. " & vbCrLf & vbCrLf
strBody = strBody & GetParticipants(mintTRBID)
' ***** MINUTES (AGENDA ITEM STATUS) *****
'Getting the agenda items and comments
' Lead in text for the agenda items
strBody = strBody & "The following agenda items were discussed at the TRB. " _
& vbCrLf & vbCrLf
strBody = strBody & GetAgendaItems(mintTRBID)
' ***** MINUTES (IR STATUS) *****
'Getting the scheduled IRs and status
' Lead in text for the incident reports
strBody = strBody & "The following Incident Reports were reviewed at the " _
& "Technical Review Board:" & vbCrLf & vbCrLf
'Getting the status of IRs for this TRB
strBody = strBody & GetIRStatus(mintTRBID)
' ***** MINUTES (ACTION ITEM STATUS) *****
'Getting the action items and status
' Lead in text for the incident reports
strBody = strBody & "The following action items were established at the TRB. " _
& vbCrLf & vbCrLf
'Getting the action item status from the TRB.
strBody = strBody & GetActionItemStatus(mintTRBID)
' ***** MINUTES (SALUTATION) *****
'Getting the salutation
strBody = strBody & GetSalutation()
Case IMMEDIATE
'Getting the addressee for the CM Manager
' ***** IMMMEDIATE (ADDRESSEE) *****
strAddressees = GetCMAddress()
'Defining the subject
' ***** IMMMEDIATE (SUBJECT) *****
strSubject = "Immediate Priority Notification Message (" & mstrIRNbr & "

"
'Building the message
' ***** IMMMEDIATE (BODY) *****
strBody = BuildIRMessage(mstrIRNbr)
Case Else
End Select
' Send out the constructed message
DoCmd.SendObject _
OutputFormat:=acFormatTXT, _
To:=strAddressees, _
Subject:=strSubject, _
MessageText:=strBody, _
EditMessage:=True
If MsgBox("Do you want to log the " & IIf(bAgenda, "agenda", ""

_
& IIf(bMinutes, "minutes", ""

& IIf(bImmediate, "immediate message", ""

, _
vbYesNo + vbInformation) = vbYes Then
If bAgenda Then
mstrSQL = "UPDATE tblTRBSchedule " _
& "SET DateAgendaMailed = #" & Now() & "# " _
& "WHERE TRBID=" & mintTRBID & ";"
DoCmd.RunSQL mstrSQL
ElseIf bMinutes Then
mstrSQL = "UPDATE tblTRBSchedule " _
& "SET DateMinutesMailed = #" & Now() & "# " _
& "WHERE TRBID=" & mintTRBID & ";"
DoCmd.RunSQL mstrSQL
End If
End If
Exit_Proc:
Exit Sub
HandleErr:
Select Case Err.Number
Case 2501 ' Cancel
Resume Next
Case Else
MsgBox "Error: " & Err.Number & ", " & Err.Description
Resume Exit_Proc
Resume
End Select
End Sub
Private Sub Form_Open(Cancel As Integer)
Set db = CurrentDb
Dim intSelected As Integer
mstrCaption = Me.Caption
Me.Caption = "Select a TRB or Message!"
If Len(Me.OpenArgs) > 0 Then
intSelected = CInt(Me.OpenArgs)
Me.fraMsgType = intSelected
fraMsgType_AfterUpdate
End If
End Sub
Private Sub fraMsgType_AfterUpdate()
Dim mstrSQL As String
Dim var
Me.lblBanner.Caption = ""
If mintTRBID > -1 Then
Select Case Me.fraMsgType
Case AGENDA, MINUTES
Me.TRBList.ColumnCount = 6
Me.TRBList.ColumnWidths = "0" & """" & ";0.5827" & """" & ";0.6" & """" _
& ";1.5938" & """" & ";0" & """" & ";0" & """"
mstrSQL = TRBLISTTRB
Case IMMEDIATE
Me.TRBList.ColumnCount = 2
var = Me.TRBList.ColumnWidths
Me.TRBList.ColumnWidths = ".5" & """" & ";1.5" & """"
mstrSQL = TRBLISTIMMEDIATE
Case Else
End Select
If mstrSQL <> Me.TRBList.RowSource Then
Me.TRBList.RowSource = mstrSQL
End If
TurnOnSend
End If
End Sub
Private Sub TRBList_Click()
Const IRNbr As Integer = 0
Const IRTitle As Integer = 1
Const TRBID As Integer = 0
Const TRBDATE As Integer = 1
Const TRBTIME As Integer = 2
Const LOCATION As Integer = 3
Const DATEOFAGENDA As Integer = 4
Const DATEOFMINUTES As Integer = 5
' Reinit those variables which may already be built
mstrAddressee = ""
mstrBody = ""
mstrSubject = ""
mstrSalutation = ""
mstrIRNbr = ""
mstrIRTitle = ""
mbMessageSelected = True
TurnOnSend
Select Case Me.fraMsgType
Case AGENDA, MINUTES
With Me.TRBList
mintTRBID = .Column(TRBID)
mstrTRB_Date = .Column(TRBDATE)
mstrTRB_Time = .Column(TRBTIME)
mstrLocation = .Column(LOCATION)
mstrDateAgendaMailed = .Column(DATEOFAGENDA)
mstrDateMinutesMailed = .Column(DATEOFMINUTES)
Me.lblBanner.Caption = " " _
& Format(CDate(mstrTRB_Date), "dd-mmm-yy"

& " TRB " _
& "(Agenda: " & IIf(Len(mstrDateAgendaMailed) > 0, Format(mstrDateAgendaMailed, "dd-mmm-yy" & " -- "

, "None -- "

_
& "Minutes: " & IIf(Len(mstrDateMinutesMailed) > 0, Format(mstrDateMinutesMailed, "dd-mmm-yy"

& "

", "None)"
End With
Case IMMEDIATE
mintTRBID = -1
mstrTRB_Date = ""
mstrTRB_Time = ""
mstrLocation = ""
With Me.TRBList
mstrIRNbr = .Column(IRNbr)
mstrIRTitle = .Column(IRTitle)
End With
Case Else
End Select
Me.cmdSend.Enabled = True
End Sub
Public Sub TurnOnSend()
If Me.fraMsgType <> 0 And mbMessageSelected Then
Me.cmdSend.Enabled = True
End If
End Sub
Growth follows a healthy professional curiosity