SENDING EMAIL USING VBA USING EXCEL SHEET AS BODY WITH VOTING OPTION

SENDING EMAIL USING VBA USING EXCEL SHEET AS BODY WITH VOTING OPTION

Sub Run_Mailers()
    Dim L_row, L_col As Long, DataRng As Range, Datasht As Worksheet, Tempsht As Worksheet, AA_rng As Range, LRow_AA As Long, AA_Wb As Workbook, Att_filenm As String, AA_Email As Long, str_sub As String
    Dim strVotOpt As Variant, tbl_mailbody As Range
    Dim applOL As Object
    Dim miOL As Object
     
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
 
    '************ Adding Voting Option
    strVotOpt = ""
    For Each vop In Sheet3.Range("VotingDropDowns")
        strVotOpt = strVotOpt & vop & ";"
    Next vop
 
    Set Datasht = Sheet1
    Datasht.Activate
 
     ActiveSheet.AutoFilterMode = False
    '************ Getting Base data last row and column
    L_row = Cells(5, 1).End(xlDown).Row
    L_col = Cells(5, 1).End(xlToRight).Column
 
    Set DataRng = Range(Cells(5, 1), Cells(L_row, L_col))
 
    '************ Getting list of AA to whom mail will be going to sent out
    Range(Cells(5, Range("AAName").Column), Cells(L_row, Range("AAName").Column)).Select
    Selection.Copy
    Set Tempsht = ActiveWorkbook.Sheets.Add
    Cells(1, 1).Select
    ActiveSheet.Paste
    ActiveSheet.Name = "TblTemp"
 
    LRow_AA = Cells(1, 1).End(xlDown).Row
 
    '************ Removing Duplicated from AA List
    ActiveSheet.Range(Cells(1, 1), Cells(LRow_AA, 1)).RemoveDuplicates Columns:=1, Header:=xlYes
 
    LRow_AA = Cells(1, 1).End(xlDown).Row
 
    Set AA_rng = Range(Cells(2, 1), Cells(LRow_AA, 1))
 
    Datasht.Activate
 
    '************ Selecting Base data for filter
    DataRng.Select
 
 
    For Each AA_Name In AA_rng
     
        '************ Using Filter on base data on basis of every AA
        DataRng.Select
        Selection.AutoFilter
        Selection.AutoFilter Field:=Range("AAName").Column, Criteria1:=AA_Name
     
        '************ Getting Row Number for AA Email Address
        Cells(5, Range("AAName").Column).Select
        ActiveCell.Offset(1, 0).Select
        Do Until ActiveCell.Height <> 0
        ActiveCell.Offset(1, 0).Select
        Loop
        AA_Email = ActiveCell.Row
     
        If Cells(ActiveCell.Row, Range("EmailStatus").Column) <> "Email Sent" Then
     
            '************ Selection visible cells after filter
            Range(Cells(5, 1), Cells(L_row, Range("AAComments").Column)).Select
            Selection.SpecialCells(xlCellTypeVisible).Select
            Selection.Copy
         
            '************ Adding new sheets
            ActiveWorkbook.Sheets.Add
         
            '************ Pasting filter data
            ActiveSheet.Paste
            Selection.Columns.AutoFit
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            Set tbl_mailbody = Selection
            Dim tblHtml As Variant
            tblHtml = RangetoHTML(tbl_mailbody)
            ActiveSheet.Delete
            'ActiveSheet.Name = AA_Name
         
            '************ Moving data to another workbook
            'ActiveSheet.Move
         
            'Set AA_Wb = ActiveWorkbook
         
           ' Att_filenm = "C:\temp\" & AA_Name & ".xlsx"
       
         
            'AA_Wb.SaveAs (Att_filenm)
            'AA_Wb.Close True
         
            ThisWorkbook.Activate
         
            Set applOL = CreateObject("Outlook.Application")
 
            Set miOL = applOL.CreateItem(0)
           
            With miOL
            .To = Cells(AA_Email, Datasht.Range("AAEmails").Column)
            .CC = ""
            '.BCC = "CPScheduling@moodys.com"
            .Importance = olImportanceNormal
            .SentOnBehalfOfName = "CPScheduling@moodys.com"
            .Subject = Sheet2.Cells(2, Sheet2.Range("Subject").Column)
            .HTMLBody = Sheet2.Range("EmailBody1") & tblHtml & Sheet2.Range("EmailBody2")
         
            '.VotingOptions = strVotOpt
            'add host workbook as an attachment to the mail:
            If Len(Att_filenm) > 0 Then
                .Attachments.Add Att_filenm
            End If
            '.ReadReceiptRequested = True
            .send
            End With
         
            'clear the object variables:
            Set applOL = Nothing
            Set miOL = Nothing
         
            'Kill (Att_filenm)
         
            Datasht.Range(Cells(5, Range("EmailStatus").Column), Cells(L_row, Range("EmailStatus").Column)).Select
            Selection.SpecialCells(xlCellTypeVisible).Select
            Selection.Value = "Email Sent"
        End If
        ActiveSheet.AutoFilterMode = False
    Next AA_Name
 
 
    ThisWorkbook.Sheets("TblTemp").Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
End Sub