excel vba to send email to multiple recipients in CC

Hello everyone,
I am trying to find out if there is a way to first create a PDF document from the Print_Area (colored range) of the Worksheet named "Chavo". Secondly open outlook and attach the PDF document. Email it to the supervisor in column J and carbon copy to all of the emails from K to M column of that particular employee by looking in cell IA. I believe in order to accomplish this the macro or function should first copy the colored area, then look up the value in cell I4 in the EmailAddress Column A:A and match from J to M column.
See attachment
Again,
Thanks to everyone who contribute to this wonderful forum.

Hi there,

Take a look at the attached workbook and see if it does what you need.

Option Private Module
Option Explicit


'=========================================================================================
'=========================================================================================


Public Sub EmailReport()

    Const sWORKSHEET_NAME   As String = "Chavo"
    Const sPDF_EXTENSION    As String = ".pdf"

    Dim sTemporaryFileName  As String
    Dim sEmployeeName       As String
    Dim sEmail_To           As String
    Dim sEmail_CC           As String
    Dim wksSource           As Worksheet

'   Specify the FullName to be used for storing the temporary PDF file
    sTemporaryFileName = ThisWorkbook.Path & "\" & sWORKSHEET_NAME & sPDF_EXTENSION

'   Create a reference to the Chavo worksheet
    Set wksSource = Worksheets(sWORKSHEET_NAME)

'   Check that the EmployeeId shown on the Chavo worksheet can be located on the
'   Addresses worksheet, and if so, retrieve the Employee Name and the Email Addresses
    Call GetEmailData(wksSource:=wksSource, sEmployeeName:=sEmployeeName, _
                      sEmail_To:=sEmail_To, sEmail_CC:=sEmail_CC)

'   Proceed only if an Email Address has been located
    If sEmail_To <> vbNullString Then

'       Create a temporary PDF version of the Chavoo worksheet
        Call CreatePdfFile(wksSource:=wksSource, sTemporaryFileName:=sTemporaryFileName)

'       Proceed only if the PDF file has been successfully created
        If Dir$(sTemporaryFileName) <> vbNullString Then

'           Create the Email with the appropriate Addressees and the PDF file attachment
            Call CreateEmail(sFileName:=sTemporaryFileName, _
                             sEmployeeName:=sEmployeeName, _
                             sEmail_To:=sEmail_To, sEmail_CC:=sEmail_CC)

'           Delete the temporary PDF file now that the Email has been created
            Call DeletePdfFile(sTemporaryFileName:=sTemporaryFileName)

        End If

    End If

End Sub


'=========================================================================================
'=========================================================================================


Private Sub CreatePdfFile(wksSource As Worksheet, sTemporaryFileName As String)

    wksSource.ExportAsFixedFormat Filename:=sTemporaryFileName, _
                                  IncludeDocProperties:=True, _
                                  Quality:=xlQualityStandard, _
                                  IgnorePrintAreas:=False, _
                                  OpenAfterPublish:=False, _
                                  Type:=xlTypePDF

End Sub


'=========================================================================================
'=========================================================================================


Private Sub GetEmailData(wksSource As Worksheet, sEmployeeName As String, _
                         sEmail_To As String, sEmail_CC As String)

'   Specify the Name of the Addresses worksheet and the numbers of the appropriate columns
    Const iCOLUMN_EMPLOYEE_NAME As Integer = 2
    Const iCOLUMN_EMPLOYEE_ID   As Integer = 1
    Const iCOLUMN_SUPERVISOR    As Integer = 10
    Const iCOLUMN_OPERATION     As Integer = 12
    Const iCOLUMN_DIVISION      As Integer = 11
    Const sID_CELL_ADDRESS      As String = "I4"
    Const iCOLUMN_SHIFT         As Integer = 13
    Const sSHEET_NAME           As String = "EmailAddress"

    Dim wksEmailAddresses       As Worksheet
    Dim rEmployeeCell           As Range
    Dim lEmployeeId             As Long
    Dim rIdCell                 As Range

'   Locate the EmployeeId cell on the Chavo worksheet
    Set rIdCell = wksSource.Range(sID_CELL_ADDRESS)

'   Retrieve the value of the EmployeeId
    lEmployeeId = rIdCell.Value

'   Check that an EmployeeId has been retrieved
    If lEmployeeId > 0 Then

'       Create a reference to the Addresses worksheet
        Set wksEmailAddresses = Worksheets(sSHEET_NAME)

'       On the Addresses worksheet . . .
        With wksEmailAddresses

'           . . . locate the cell which contains the specified EmployeeId
            With .Columns(iCOLUMN_EMPLOYEE_ID).Cells
                Set rEmployeeCell = .Find(What:=lEmployeeId, LookIn:=xlValues, _
                                          LookAt:=xlWhole)
            End With

'           Proceed only if the cell containing the specified EmployeeId has been located
            If Not rEmployeeCell Is Nothing Then

'                 Retrieve the Name associated with the specified EmployeeId
                  sEmployeeName = Intersect(rEmployeeCell.EntireRow, _
                                            .Columns(iCOLUMN_EMPLOYEE_NAME)).Value

'                 Retrieve the Supervisor Email for the specified EmployeeId
                  sEmail_To = Intersect(rEmployeeCell.EntireRow, _
                                        .Columns(iCOLUMN_SUPERVISOR)).Value

'                 Retrieve the Division Manager Email for the specified EmployeeId
                  sEmail_CC = Intersect(rEmployeeCell.EntireRow, _
                                        .Columns(iCOLUMN_DIVISION)).Value & ", "

'                 Retrieve the Operation Manager Email for the specified EmployeeId
                  sEmail_CC = sEmail_CC & _
                              Intersect(rEmployeeCell.EntireRow, _
                                        .Columns(iCOLUMN_OPERATION)).Value & ", "
'                 Retrieve the Shift Manager Email for the specified EmployeeId
                  sEmail_CC = sEmail_CC & _
                              Intersect(rEmployeeCell.EntireRow, _
                                        .Columns(iCOLUMN_SHIFT)).Value

'           Display an error message if the specified EmployeeId could not be located
            Else: MsgBox "Employee ID " & lEmployeeId & _
                         " cannot be located in the Email Addresses worksheet", vbCritical


            End If

        End With

    End If

End Sub


'=========================================================================================
'=========================================================================================


Private Sub CreateEmail(sFileName As String, sEmployeeName As String, _
                        sEmail_To As String, sEmail_CC As String)

    Const iMAIL_ITEM    As Integer = 0

    Dim sEmailAddress   As String
    Dim objMailItem     As Object
    Dim objOutlook      As Object

'   Create a reference to an instance of Outlook
    Set objOutlook = mobjOutlookApplication()

    With objOutlook

'       Create an empty Email
        Set objMailItem = .CreateItem(iMAIL_ITEM)

'       Populate the Email with the appropriate items
        With objMailItem

            .To = sEmail_To
            .cc = sEmail_CC

'           The following texts may be altered to suit requirements
            .Subject = "Employee Report  -  " & sEmployeeName
            .Body = "Employee report attached as requested"

'           Disable error handling for the next step - this avoids an error if
'           the cancel button on the "Select Profile" dialog box is pressed
            On Error Resume Next
                .Attachments.Add sFileName
            On Error GoTo 0

            .Display

        End With

    End With

End Sub


'=========================================================================================
'=========================================================================================


Private Sub DeletePdfFile(sTemporaryFileName As String)

    On Error Resume Next
        Kill PathName:=sTemporaryFileName
    On Error GoTo 0

End Sub


'=========================================================================================
'=========================================================================================


Private Function mobjOutlookApplication() As Object

    Const sOUTLOOK As String = "Outlook.Application"

    On Error Resume Next
        Set mobjOutlookApplication = GetObject(vbNullString, sOUTLOOK)
    On Error GoTo 0

    If mobjOutlookApplication Is Nothing Then
        Set mobjOutlookApplication = CreateObject(sOUTLOOK)
    End If

End Function

The text of the .Subject and .Body properties of the Email may be customised as required.

Changes to the layout of the EmailAddresses worksheet can be accommodated by altering the values of the appropriate constants.

Hope this helps - please let me know how you get on with it.

Regards,

Greg M

Mr. Greg M.
This is the most brilliant work I ever seen. It work perfectly and it does just exactly what I was looking for. Thank you very much for your time and work.
I don't have enough words to thank you,
Sincerely,
Kimston

Hi again Kimston,

Many thanks for your feedback, your kind words and also for the Reputation increase

I'm very pleased that I was able to help.

Best regards,

Greg M

Hi
Need a rotating roster spread shift for shift workers that can calculate hours per day and month.

Here is an example of what i require. However i need a better version that i could print on A4 paper that can be readable.