Query in excel to Outlook mail take rows with name until next name

[esben]

Dear all,

Im trying to avoid sending mails out every week with new tasks for people. Therefor i try to create a code that can look at my query data and sent it to the correct person in outlook.

I would like to make a code which takes the header and table data for rows with specific name and blanks until next name.

The table looks like:

Header	Header	Header	Header	Not included header
Name	Data	Data	Data	Data
	Data		Data
Name	Data	Data	Data	Data
	Data		Data
	Data	Data

I wrote some code a long time ago for sending mail for every Name on NameList.

I do not think i requires a whole lot of change to the code - but it is a bit behind me so i hope someone has a quick eye for it.

Sub Overdue_Tasks()

Dim EApp As Object
Set EApp = CreateObject("Outlook.Application")

Application.ScreenUpdating = False

Dim EItem As Object

Dim NameList As Range
Set NameList = Range("A2", Range("a2").End(xlDown))

'Table header.
    Dim iColumnsCount, iColCnt As Integer
    Dim sTableHeads As String
    iColumnsCount = ActiveSheet.UsedRange.Columns.Count - 1
    
    For iColCnt = 1 To iColumnsCount
'Table header concatenated with HTML <th> tags.
        If (sTableHeads) = "" Then
            sTableHeads = "<th>" & ActiveSheet.Cells(1, iColCnt) & "</th>"
        Else
            sTableHeads = sTableHeads & "<th>" & ActiveSheet.Cells(1, iColCnt) & "</th>"
        End If
    Next iColCnt

' The list of names in excel sheet

'For Name = 2 To NameList.Count
For Name = 2 To 6

' Table data.

    Dim iRowsCount, iRows As Integer
    Dim sTableData As String
    iRowsCount = ActiveSheet.Rows.Count
     
    sTableData = "<tr>"
    For iColCnt = 1 To iColumnsCount
        If (sTableData) = "" Then
            sTableData = "<td>" & ActiveSheet.Cells(Name, iColCnt) & "</td>"
        Else
            sTableData = sTableData & "<td>" & ActiveSheet.Cells(Name, iColCnt) & "</td>"
        End If
    
    Next iColCnt
    sTableData = sTableData & "</tr>"
    

' Add CSS style to the table.
    
    Dim sTableStyle As String
    sTableStyle = "<style> table.edTable { width: 75%; font: 18px calibri; } table, table.edTable th, table.edTable td { border: solid 1px #000000; border-collapse: collapse; padding: 3px; text-align: center; } table.edTable td { background-color: #ffffff; color: #000000; font-size: 14px; } table.edTable th { background-color : #ffffff; color: #000000; } tr:hover td { background-color: #000000; color: #ffffff; } </style>"
    
    Set EItem = EApp.CreateItem(0)
    
    With EItem
        
        .To = ActiveSheet.Cells(Name, 1) & "@xxxxxx.com"
        
        '.CC = "AEIR@lundbeck.com"
        .Subject = "Overdue QN task " & ActiveSheet.Cells(Name, 1)
        .HTMLbody = "Dear " & ActiveSheet.Cells(Name, 1) & "," & "<br>" & "<br>" _
                    & sTableStyle & "<table class='edTable'><tr>" & sTableHeads & "</tr>" & sTableData & "</tr>" & "</table>" & "<br>" & "<br>" _
                    & Signature

            .Display
            'SendKeys "^{ENTER}"
        
    End With
Next Name

Application.ScreenUpdating = True

End Sub