F
funkymonkUK
Hi
I have a table example
ID First Name Last Name
1 Bob Smith
2 Tom Black
3 John Turner
in a workbook how do I get this table into a body on an email
Ihave the following which goes into a body however i would like it to
be in a table format with borders etc.
Code:
--------------------
Sub TestFile()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strbody As String
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In ThisWorkbook.Sheets("mail").Range("h6:h14")
strbody = strbody & cell.Value & vbNewLine
Next
For Each cell In Sheets("mail").Columns("b").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Value
.Subject = Sheets("mail").Range("h1").Value
.Body = "Hello " & cell.Offset(0, -1).Value & vbNewLine & vbNewLine & strbody
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.send 'Or use send
End With
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
I have a table example
ID First Name Last Name
1 Bob Smith
2 Tom Black
3 John Turner
in a workbook how do I get this table into a body on an email
Ihave the following which goes into a body however i would like it to
be in a table format with borders etc.
Code:
--------------------
Sub TestFile()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strbody As String
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In ThisWorkbook.Sheets("mail").Range("h6:h14")
strbody = strbody & cell.Value & vbNewLine
Next
For Each cell In Sheets("mail").Columns("b").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Value
.Subject = Sheets("mail").Range("h1").Value
.Body = "Hello " & cell.Offset(0, -1).Value & vbNewLine & vbNewLine & strbody
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.send 'Or use send
End With
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub