help adjusting code

[stebrownsword]

hi,

I'm clueless at coding so would appreciate the following significantly


How can I adapt the following so that it adds the test "This is where I insert the text" above the table in the email and can the macro also send out the email? (currently it creates the email but doesn't send)

the macro currently, creates a table in Email







Sub Send_Table()

'Set email address as range for first loop to run down
Set rng = Range(Range("G2"), Range("G" & Rows.Count).End(xlUp))

'Get a row count to clear column H at the end
x = rng.Rows.Count

'Create the html table and header from the first row
tableHdr = "<table border=1><tr><th>" & Range("A1").Value & "</th>" _
& "<th>" & Range("B1").Value & "</th>" _
& "<th>" & Range("C1").Value & "</th>" _
& "<th>" & Range("D1").Value & "</th>" _
& "<th>" & Range("E1").Value & "</th>" _
& "<th>" & Range("F1").Value & "</th>" _

'Check to see if column H = 'yes' and skip mail if it does
For Each cell In rng
If cell.Value <> "" Then
If Not cell.Offset(0, 1).Value = "yes" Then


NmeRow = cell.Row

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.createitem(0)

MailTo = cell.Value 'column G
MailSubject = cell.Offset(0, -3).Value 'column D

'Create MailBody table row for first row
MailBody = "<tr>" _
& "<td>" & cell.Offset(0, -6).Value & "</td>" _
& "<td>" & cell.Offset(0, -5).Value & "</td>" _
& "<td>" & cell.Offset(0, -4).Value & "</td>" _
& "<td>" & cell.Offset(0, -3).Value & "</td>" _
& "<td>" & cell.Offset(0, -2).Value & "</td>" _
& "<td>" & cell.Offset(0, -1).Value & "</td>" _
& "</tr>"

'Second loop checks the email addresses of all cells following the current cell in the first loop.
'Yes will be appended on any duplicate finds and another row added to the mailbody table
For Each dwn In rng.Offset(NmeRow - 1, 0)



If dwn.Value = cell.Value Then

'Create additional table row for each extra row found
AddRow = "<tr>" _
& "<td>" & dwn.Offset(0, -6).Value & "</td>" _
& "<td>" & dwn.Offset(0, -5).Value & "</td>" _
& "<td>" & dwn.Offset(0, -4).Value & "</td>" _
& "<td>" & dwn.Offset(0, -3).Value & "</td>" _
& "<td>" & dwn.Offset(0, -2).Value & "</td>" _
& "<td>" & dwn.Offset(0, -1).Value & "</td>" _
& "</tr>"

dwn.Offset(0, 1).Value = "yes"
MailBody = MailBody & AddRow 'column A

End If
' Clear additional table row variable ready for next
AddRow = ""
Next
With OutMail
.To = MailTo
.Subject = MailSubject
.HTMLBody = tableHdr & MailBody & "</table>"
.Display
'send
End With

cell.Offset(0, 1).Value = "yes"

End If
End If


MailTo = ""
MailSubject = ""
MailBody = ""
Next

'Clear 'yes' from all appended cells in column H
Range("H2:H" & x).ClearContents
End Sub

 

[James006]

Hello,

Ron de Bruin's site is an excellent source :

https://www.rondebruin.nl/win/s1/outlook/mail.htm

Hope this will help

 

[DanteAmor]

I put the updated code.


The With-End With segment must go within the For Each dwn In rng.Offset(NmeRow - 1, 0), because in the lines you use the dwn object.

To send the mail you must use the instruction .Send

Note: I also recommend you to declare all the variables in an appropriate way, this will help you some errors in the coding.

Sub Send_Table()
[COLOR=#0000ff]  Dim rng As Range, x As Long, tableHdr As String, cell As Range[/COLOR]
[COLOR=#0000ff]  Dim NmeRow As Long, OutApp As Object, OutMail As Object, MailTo As String[/COLOR]
[COLOR=#0000ff]  Dim MailSubject As String, MailBody As String, dwn As Range, AddRow As String[/COLOR]
  ' 

  'Set email address as range for first loop to run down
  Set rng = Range(Range("G2"), Range("G" & Rows.Count).End(xlUp))
  'Get a row count to clear column H at the end
  x = rng.Rows.Count
  'Create the html table and header from the first row
  tableHdr = "" _
  & "" _
  & "" _
  & "" _
  & "" _
  & "" _
  'Check to see if column H = 'yes' and skip mail if it does
  For Each cell In rng
    If cell.Value <> "" Then
      If Not cell.Offset(0, 1).Value = "yes" Then
        NmeRow = cell.Row
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.createitem(0)
        MailTo = cell.Value 'column G
        MailSubject = cell.Offset(0, -3).Value 'column D
        'Create MailBody table row for first row
        MailBody = "" _
        & "" _
        & "" _
        & "" _
        & "" _
        & "" _
        & "" _
        & ""
        'Second loop checks the email addresses of all cells following the current cell in the first loop.
        'Yes will be appended on any duplicate finds and another row added to the mailbody table
        For Each dwn In rng.Offset(NmeRow - 1, 0)
          If dwn.Value = cell.Value Then
            'Create additional table row for each extra row found
            AddRow = "" _
            & "" _
            & "" _
            & "" _
            & "" _
            & "" _
            & "" _
            & ""
            dwn.Offset(0, 1).Value = "yes"
            MailBody = MailBody & AddRow 'column A
          End If
          ' Clear additional table row variable ready for next
          AddRow = ""
[COLOR=#0000ff]          With OutMail[/COLOR]
[COLOR=#0000ff]            .To = MailTo[/COLOR]
[COLOR=#0000ff]            .Subject = MailSubject[/COLOR]
[COLOR=#0000ff]            .HTMLBody = tableHdr & MailBody & " " & Range("A1").Value & " " & _[/COLOR]
[COLOR=#0000ff]              Range("B1").Value & " " & Range("C1").Value & " " & Range("D1").Value & " " & _[/COLOR]
[COLOR=#0000ff]              Range("E1").Value & " " & Range("F1").Value & " " & cell.Offset(0, -6).Value & "  " & _[/COLOR]
[COLOR=#0000ff]              cell.Offset(0, -5).Value & "  " & cell.Offset(0, -4).Value & "  " & _[/COLOR]
[COLOR=#0000ff]              cell.Offset(0, -3).Value & "  " & cell.Offset(0, -2).Value & "  " & _[/COLOR]
[COLOR=#0000ff]              cell.Offset(0, -1).Value & " " & dwn.Offset(0, -6).Value & " " & _[/COLOR]
[COLOR=#0000ff]              dwn.Offset(0, -5).Value & " " & dwn.Offset(0, -4).Value & " " & _[/COLOR]
[COLOR=#0000ff]              dwn.Offset(0, -3).Value & " " & dwn.Offset(0, -2).Value & " " & dwn.Offset(0, -1).Value & " "[/COLOR]
[COLOR=#0000ff]            '.Display[/COLOR]
[COLOR=#0000ff]            .[/COLOR][B][COLOR=#ff0000]Send[/COLOR][/B][COLOR=#0000ff][/COLOR]
[COLOR=#0000ff]          End With[/COLOR]
          cell.Offset(0, 1).Value = "yes"
        Next
      End If
    End If
    MailTo = ""
    MailSubject = ""
    MailBody = ""
  Next
  'Clear 'yes' from all appended cells in column H
  Range("H2:H" & x).ClearContents
End Sub