stebrownsword

Board Regular
Joined
Apr 16, 2010
Messages
151
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
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
14,155
Office Version
  1. 2007
Platform
  1. Windows
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.

Code:
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
 
Learn Excel from Bill Jelen

Understanding data is crucial, and the easiest place to start is with Microsoft Excel.

Forum statistics

Threads
1,151,589
Messages
5,765,321
Members
425,273
Latest member
tonio909

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top