Email Query Results

[adidashawn6]

I am currently working with a database that I inherited. I have a ComboBox for the "Reason" an employee would call out. The ComboBox has a total of 12 different options that could be selected. Of these 12, there are 3 reasons that will require an email to be sent. The information entered into the form is added to a table using an Append Query, so all of the information that would need to be included in the email would come from the query results. The information from the query that would be added to the email will be different depending on which of the 3 options are selected. I am using Outlook to send the emails. I guess you could say they will be conditional emails. Only if certain options are selected in the ComboBox, will an email be generated. And, depending on which option is selected will determine what information the email has in the subject line as well as the body of the email. I assume that the code will have "If" statements in it to determine which subject and email body to use, but I am a newbie when it comes to VBA code. Any help would be much appreciated.

[Bob McClellan]

This should get you moving in the right direction....
This example (pasted from an app using similar functionality)
is sending a report as an rtf... 2007 allows for .pdf output but I believe
prior versions restrict you to .rtf

simply check for the scenarios you are targeting and run the code
if the vars meet the prerequisites

something like....
if me.combo.coloumn(0) = 1 or me.combo.coloumn(0) = 3 or me.combo.coloumn(0) = 7 then
dim eMailString as string
eMailString = "Name@yourplace.com"

Dim stDocName As String
Dim emailTo As String
Dim emailSubject As String
Dim emailMessage As String

stDocName = "rptExtras"
emailTo = eMailString
emailSubject = "Extras Report"
emailMessage = "Attached is the report showing the extras."

DoCmd.SendObject _
acSendReport, _
stDocName, _
acFormatRTF, _
emailTo, _
, _
, _
emailSubject, _
emailMessage, _
False
end if

hth,
..bob

[adidashawn6]

ok, i have made a few more mods to the code, but i am still getting "run time error 3061 too few parameters expected 11". It is highlighting the line "Set rst = dbs.OpenRecordset(strSQL)" Here is my modified code. Can anyone help with this error i am receiving?

Private Sub Command65_Click()
Dim dbs As Database
Dim rst As Recordset
Dim messagebody As String
Dim strSQL As String


strSQL = "SELECT Forms![Attendance Data Entry]![Employee Name] AS [Employee Name], [Employee Data Table].EMAIL_ADDRESS, Forms![Attendance Data Entry]!Coach AS [Coach Name], Forms![Attendance Data Entry]!Combo18 AS [Exception Code], Forms![Attendance Data Entry]!Dattefield AS [Date of Exception], Forms![Attendance Data Entry]!ShiftType AS SameDay_PTO, Forms![Attendance Data Entry]!SD_ATO_StartTime AS SameDayATO_Start, Forms![Attendance Data Entry]!SD_ATO_EndTime AS SameDayATO_End, Forms![Attendance Data Entry]!SA_Start_Time AS Shift_ADJ_Start, Forms![Attendance Data Entry]!SA_EndTime AS Shift_ADJ_End, Forms![Attendance Data Entry]!Coach_Email AS Coach_Email, Forms![Attendance Data Entry]!Manager_Email AS Manager_Email"
strSQL = strSQL & " FROM [Employee Data Table]"
strSQL = strSQL & " GROUP BY Forms![Attendance Data Entry]![Employee Name], [Employee Data Table].EMAIL_ADDRESS, Forms![Attendance Data Entry]!Coach, Forms![Attendance Data Entry]!Combo18, Forms![Attendance Data Entry]!Dattefield, Forms![Attendance Data Entry]!ShiftType, Forms![Attendance Data Entry]!SD_ATO_StartTime, Forms![Attendance Data Entry]!SD_ATO_EndTime, Forms![Attendance Data Entry]!SA_Start_Time, Forms![Attendance Data Entry]!SA_EndTime, Forms![Attendance Data Entry]!Coach_Email, Forms![Attendance Data Entry]!Manager_Email; "

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL)
messagebody = " "
If rst![Exception Code] = "Same Day ATO" Then
messagebody = "" & rst![Employee Name] & " was given " & rst![Exception Code] & " for " & rst![Date of Exception] & " from " & rst![SameDayATO_Start] & " to " & rst![SameDayATO_End] & vbCrLf
End If

'Debug.Print messagebody

' pass details to function
xyz = Mail_report(messagebody)

rst.Close
dbs.Close
Set rst = Nothing
Set dbs = Nothing
End Sub

Function Mail_report(body_txt As String)

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object
    Dim subject As String
    Dim dbs As Database
    Dim rst As Recordset


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("Attendance Append")

     subject = rst![Employee Name] & rst![Exception Code] & rst![Date of Exception]
    
     On Error Resume Next
        
        With OutMail
            .To = "Email@email.com"
            .CC = ""    'CC_email
            .BCC = ""
            .subject = subject
            .Body = body_txt
            '.Attachments.Add path ' path could hold a filename to attach
            .Send
        End With
        On Error GoTo 0
    

    Set OutMail = Nothing
    Set OutApp = Nothing
    Set rst = Nothing
    Set dbs = Nothing

Mail_ActiveSheet = True

End Function

[adidashawn6]

OK, so now I have the email being generated with the below code. The last thing I need to figure out is how to make this and If statement. I know I will have to modify the code for each of the instances that require an email, that shouldn’t be a problem. I am just unsure how to code this so that it only sends an email if 1 of 3 different options are selected from "Combo18". There are 12 different options that can be selected, but only 3 of them will generate the email. Here is the code that I have so far:

 
Private Sub Command65_Click()
Dim email As String
Dim email2 As String
Dim email3 As String
Dim emp As String
Dim except As String
Dim exceptdate As String
Dim exceptSDStime As String
Dim exceptSDEtime As String
Dim exceptSAStime As String
Dim exceptSAEtime As String
Dim subexcept As String
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
email = Me!Coach_Email
email2 = Me!Manager_Email
email3 = "email@email.com"
emp = Me![Employee Name]
except = Me!Combo18
exceptdate = Me!Dattefield
exceptSDStime = Me!SD_ATO_StartTime
exceptSDEtime = Me!SD_ATO_EndTime
exceptSAStime = Me!SA_Start_Time
exceptSAEtime = Me!SA_EndTime
subexcept = Me!ShiftType
Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
    .To = email
    .CC = email2 & ";" & email3
    .subject = emp & " " & except & " " & exceptdate
    .Body = emp & " was given " & except & " for " & exceptdate & " from " & exceptSDStime & " to " & exceptSDEtime
    .Display
End With
End Sub

[adidashawn6]

I figured it out. Here is the code that I am using incase anyone else ever has the same issue.

Private Sub Submit_Click()
Dim email As String
Dim email2 As String
Dim email3 As String
Dim emp As String
Dim except As String
Dim exceptdate As String
Dim exceptSDStime As String
Dim exceptSDEtime As String
Dim exceptSAStime As String
Dim exceptSAEtime As String
Dim subexcept As String
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem

If Me!Combo18 = "Same Day ATO" Then
email = Me!Coach_Email
email2 = Me!Manager_Email
email3 = "email@email.com"
emp = Me![Employee Name]
except = Me!Combo18
exceptdate = Me!Dattefield
exceptSDStime = Me!SD_ATO_StartTime
exceptSDEtime = Me!SD_ATO_EndTime


Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)

With objEmail
    .To = email
    .CC = email2 & ";" & email3
    .subject = emp & " " & except & " " & exceptdate
    .Body = emp & " was given " & except & " for " & exceptdate & " from " & exceptSDStime & " to " & exceptSDEtime
    .Display
End With
End If

If Me!Combo18 = "Same Day Sched Adj" Then
email = Me!Coach_Email
email2 = Me!Manager_Email
email3 = "email@email.com"
emp = Me![Employee Name]
except = Me!Combo18
exceptdate = Me!Dattefield
exceptSAStime = Me!SA_Start_Time
exceptSAEtime = Me!SA_EndTime

Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)

With objEmail
    .To = email
    .CC = email2 & ";" & email3
    .subject = emp & " " & except & exceptdate
    .Body = emp & " was given a " & except & " for " & exceptdate & ". Adjusted shift will be " & exceptSAStime & " to " & exceptSAEtime
    .Display
End With
End If

If Me!Combo18 = "Same Day PTO" Then
email = Me!Coach_Email
email2 = Me!Manager_Email
email3 = "email@email.com"
emp = Me![Employee Name]
except = Me!Combo18
exceptdate = Me!Dattefield
subexcept = Me!ShiftType


Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)

With objEmail
    .To = email
    .CC = email2 & ";" & email3
    .subject = emp & except & exceptdate
    .Body = emp & " was given a " & except & " for a " & subexcept & " on " & exceptdate & ". Please submit in Oracle A.S.A.P."
    .Display
End With
End If

Set objOutlook = Nothing
Set objEmail = Nothing

DoCmd.RunMacro "Append Macro"
    
End Sub