Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 246
  • Last Modified:

Adding Multiple Recipients to an Email Sub

I have the follwoing code that sneds me an email about an appointment that has been scheduled for an employee (say a review or something)

Private Sub EmailLineManager()        
Dim objMail As Outlook.MailItem
Set objOutlook = CreateObject("Outlook.Application")
With objMail.CreateItem(olMailItem)
    .Recipients.Add "craig@emailaddress"
    .Subject = "Appoinment added for " & Forms.frmEmployeeDetails.tboRvwFullName
    .Body = "An appointment has been scheduled for " & Forms.frmEmployeeDetails.tboRvwFullName _
            & " for " & Me!ApptDate & " at " & Me!ApptTime & ", lasting about " & Me!ApptLength _
            & vbCrLf & vbCrLf _
            & "The reason for this appointment is " & Me!Appt & "."
    .Send
Set objMail = Nothing
End If

I have in my form a Combo Box that lists the employees line manager (not me). When I call this routine, I want to send an email not only to this employees line manager, but to all line managers in the same Department. I have in my line managers table a field called DeptCode, so lets say PersonA and PersonB are in department HD, but Person C in in department CS.

Assuming that this employee reports to PersonA, in the .Recipients.Add line I would like to add not only the employees line manager (PersonA n department HD), but also PersonB, but not PersonC.

Any ideas?
End Sub
0
Craig_Muckleston
Asked:
Craig_Muckleston
  • 2
1 Solution
 
perkcCommented:
Try this:

Private Sub EmailLineManager()
Dim objMail As Outlook.MailItem
Dim rs As DAO.Recordset
Dim rssql As String
rssql = "ADD THE SQL STRING HERE THAT PULLS THE MANAGERS;"
Set rs = CurrentDb.OpenRecordset(rssql)
rs.MoveLast
rs.MoveFirst
Set objOutlook = CreateObject("Outlook.Application")
With objMail.CreateItem(olMailItem)
    .Recipients.Add "craig@emailaddress"
   
    Do While Not rs.EOF
         .Recipients.Add (rs.Fields("COLUMN NAME FOR THE MANAGER'S EMAIL"))
         rs.MoveNext
    Loop
    .Subject = "Appoinment added for " & Forms.frmEmployeeDetails.tboRvwFullName
    .Body = "An appointment has been scheduled for " & Forms.frmEmployeeDetails.tboRvwFullName _
            & " for " & Me!ApptDate & " at " & Me!ApptTime & ", lasting about " & Me!ApptLength _
            & vbCrLf & vbCrLf _
            & "The reason for this appointment is " & Me!Appt & "."
    .Send
End With
Set objMail = Nothing
rs.Close
Set rs = Nothing
End Sub

0
 
Craig_MucklestonAuthor Commented:
Hi perkc,

I have changed the code as per yours above, and edoited to pull my deprtment off, but I am getting a run-time error for Too Few Parameters Supplied. Expected 2.

My code as it stands is below

Private Sub EmailLineManager()
Dim objMail As Outlook.MailItem
Dim rs As DAO.Recordset
Dim rssql As String
Dim recDept As String
recDept = (Forms.frmEmployeeDetails.[cboDept].Column(1))

'rssql = "ADD THE SQL STRING HERE THAT PULLS THE MANAGERS;"
rssql = "SELECT tblLineManagers.LineManager "
rssql = rssql + "FROM tblLineManagers "
rssql = rssql + "WHERE tblLineManagers.tblDept = " & recDept & ";"
MsgBox (rssql)

Set rs = CurrentDb.OpenRecordset(rssql)
rs.MoveLast
rs.MoveFirst
Set objOutlook = CreateObject("Outlook.Application")
With objMail.CreateItem(olMailItem)
   
    Do While Not rs.EOF
         '.Recipients.Add (rs.Fields("COLUMN NAME FOR THE MANAGER'S EMAIL"))
         .Recipients.Add (rs.Fields("tblLineManagers.LineManager"))
         rs.MoveNext
    Loop
    .Subject = "Appoinment added for " & Forms.frmEmployeeDetails.tboRvwFullName
    .Body = "An appointment has been scheduled for " & Forms.frmEmployeeDetails.tboRvwFullName _
            & " for " & Me!ApptDate & " at " & Me!ApptTime & ", lasting about " & Me!ApptLength _
            & vbCrLf & vbCrLf _
            & "The reason for this appointment is " & Me!Appt & "."
    .Send
End With
Set objMail = Nothing
rs.Close
Set rs = Nothing
End Sub

recDept gives me the Department Name, eg, Management, Customer Services, Training, etc.
0
 
perkcCommented:
Change the following line:

rssql = rssql + "WHERE tblLineManagers.tblDept = " & recDept & ";"

to:

rssql = rssql + "WHERE tblLineManagers.tblDept = '" & recDept & "';"

Because the recDept value is text it needs to be enclosed in '.

perkc
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now