Sending emails with combination of two module

[orhanceliloglu]

Hi Everyone,

I have an employee list as attached, with manager data in column "V".

Macro is sending separate emails to each manager with an attachment. For example, a manager have 5 employee. Macro is copying that 5 row and pasting into a blank excel file and attaching that excel file to an email and sending it to the manager.

Until here, I am able to do it with below code. It is working.

But now I have a "Sheet2" which I want to do same thing. Filter the manager's employees in Sheet2 and create a second excel file and attach it into that email as well with previous attachment. Basically It will be one email with two excel attachment. Macro needs to match with managers and excel files.

I did the same code to Sheet2 as well but I dont know how to combine these two macro and send one email with two attachment ://

Any idea ?


Thanks a lot !
Orhan

Sub discrepancy()
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim header As Range
    Set Source = Nothing
    Dim recepient As String
    Dim Email_Body As String
    On Error Resume Next
    Dim overtimes As Range

    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
ActiveWorkbook.Sheets(1).Activate
        
    lastrow = Sheets(1).UsedRange.Rows.Count
    lastColumn = 22
    With Sheets(1)
        .Range(Cells(2, 1), Cells(lastrow, lastColumn)).Select
        Set overtimes = Selection
        overtimes.Sort Key1:=Range("V2"), Order1:=xlAscending
    End With
    With Sheets(1)
        .Range(Cells(1, 1), Cells(1, lastColumn)).Select
        Set header = Selection.SpecialCells(xlCellTypeVisible)
    End With
    With Sheets(1)
        For i = 2 To lastrow
            If .Cells(i, 22).Value <> .Cells(i - 1, 22).Value Then
                startrow = .Cells(i, 22).Row
            End If
            If .Cells(i, 22).Value <> .Cells(i + 1, 22).Value Then
                endrow = .Cells(i, 22).Row
                .Range(Cells(startrow, 1), Cells(endrow, lastColumn)).Select
            Else
                GoTo 1
            End If
            recepient = .Cells(i, 22).Value
            Manager = .Cells(i, 22).Value
            Set Source = Selection.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        
            If Source Is Nothing Then
                MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
                Exit Sub
            End If
        
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
            End With
            
            Set wb = ActiveWorkbook
            Set Dest = Workbooks.Add(xlWBATWorksheet)
        
            header.Copy
            With Dest.Sheets(1)
                .Cells(1, 1).PasteSpecial Paste:=8
                .Cells(1, 1).PasteSpecial Paste:=xlPasteValues
                .Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
                .Cells(1, 1).Select
                Application.CutCopyMode = False
            End With
            Source.Copy
            With Dest.Sheets(1)
                .Cells(2, 1).PasteSpecial Paste:=8
                .Cells(2, 1).PasteSpecial Paste:=xlPasteValues
                .Cells(2, 1).PasteSpecial Paste:=xlPasteFormats
                .Cells(2, 1).Select
                Application.CutCopyMode = False
            End With
        
            TempFilePath = Environ$("temp") & "\"
            TempFileName = "Vacation balance report" & " " & Manager
            emailpath = "C:\Users\celilogl\Desktop\SVK\discrepancy\"
        
            If Val(Application.Version) < 12 Then
                'You use Excel 97-2003
                FileExtStr = ".xls": FileFormatNum = -4143
            Else
                'You use Excel 2007-2016
                FileExtStr = ".xlsx": FileFormatNum = 51
            End If
        
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(olMailItem)
            
            Email_Body = "Hello,"
            Email_Body = Email_Body & "<br>" & "<br>" & "Please find attached the vacation days overview for your reports at the end of the last month."
            Email_Body = Email_Body & "<br>" & "<br>" & "Kind Regards,"
            Email_Body = Email_Body & "<br>" & "<br>" & "HR Services"
        
            With Dest
                .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
                On Error Resume Next
                With OutMail
                    .To = recepient & "@amazon.com"
                    .CC = ""
                    .BCC = ""
                    .Subject = "Vacation balance report"
                    .BodyFormat = olFormatHTML
                    .HTMLBody = Email_Body
                    .Attachments.Add Dest.FullName
                    '.Send
                    'You can add other files also like this
                    '.Attachments.Add ("C:\test.txt")
                   .SaveAs emailpath & TempFileName & ".msg"
                End With
                On Error GoTo 0
                .Close savechanges:=False
            End With
            Kill TempFilePath & TempFileName & FileExtStr
        
            Set OutMail = Nothing
            Set OutApp = Nothing
        
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
1    Next i
    End With
End Sub