Generate a fully formatted email with tables in VBA

Question

I have several pieces of information to work with.

1. An outlook email template with an automated message and 3 "insertion points" where I need a neat formatted table containing hyperlinks to me injected and send to a the saved distribution list.
2. An Master Excel spread sheet with 3 sheets which is auto updated with all the info needed to be in the tables (but does not contain hyperlinks).
3. 3 filtered Sharepoint lists that contains all the info needed to be in the table AND it contains the needed hyperlinks.

One way or another I need to make an easy (easier than opening both files and copying and pasting) method of automatically generating a formatted email with all the above listed information. I am an intern so this is as much a test of my abilities than it is a personal time saver so deviation from the requirements isn't really an option. As of now my boss is opening the email template, then opening the Sharepoint lists one by one, clicking and dragging a selection, and copying and pasting each list individually. So let me start off with what approaches I have tried and then move on to where I have hit walls.

So my first attempt wast to work in the source Excel file and generate an email as I have already done this with a few simpler automations before.

Sub GenerateEmail()
Const template As String = "--The path to the email template goes here--It works but I removed it for this post"
MakeEmail (template)
End Sub

Sub MakeEmail(templatePath As String)

'Not currently working but I'm not as concerned for it at the moment
'I havent been able to make it as far as this yet
'Dim today As String
'today = Format(Now(), "MM/DD/YYYY")
'Dim later As String
'later = Format(DateAdd("D", 28, Now()), "MM/DD/YYYY")

'---Initialize Constants for future use---
Dim OutlookApp As Variant
Dim Email As Variant

Dim requSheet As Worksheet
Dim xferSheet As Worksheet
Dim AttrSheet As Worksheet
'-----------------------------------------

'---Set Constants for future use---
Set OutlookApp = CreateObject("Outlook.Application")
Set Email = OutlookApp.CreateItemFromTemplate(templatePath)

Set requSheet = Worksheets("owssvr ReqList")
Set requSheet = Worksheets("owssvr Transfer")
Set requSheet = Worksheets("owssvr Attrit")
'----------------------------------

'create an editable copy of email body
Dim editedBody As String
editedBody = Email.HTMLBody

'copies requisitions
requSheet.Activate
Dim currentRequisitions As Range
Columns("C").EntireColumn.Hidden = True
Columns("G:H").EntireColumn.Hidden = True
Dim lner As Long
lner = LastNonEmptyRow(Range("A:A"))
Set currentRequisitions = Range(Cells(2, 1), Cells(lner, 13))
currentRequisitions.Copy

'Converts clipboard contents to String
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject
DataObj.GetFromClipboard
Dim copy1str As String
copy1str = DataObj.GetText(1)

'Make edites to editable copy
editedBody = Replace(editedBody, "54321RequisitionsFlag_DoNotRemove", copy1str) 'Requisitions
editedBody = Replace(editedBody, "54321TransfersFlag_DoNotRemove", "Place Holder2") 'Transfers
editedBody = Replace(editedBody, "54321AttritionsFlag_DoNotRemove", "Place Holder3") 'Attritions

'Replace email body with newly edited body
Email.HTMLBody = editedBody

Email.Display
End Sub

Function LastNonEmptyRow(r As Range) As Long
LastNonEmptyRow = r.Cells.Count - WorksheetFunction.CountBlank(r)
End Function

The issue I'm running into with this approach is obviously when I convert the DataObject to a string I'm losing all formatting of the table. (It gets placed as a long string of the excel values seperated by spaces) There are online resources like http://tableizer.journalistopia.com/ Which I would use to convert the text to an HTML table (if it were me) But again.. I am an intern and the task was to automate it so that's what I have to do. So I need to some way have it maintain table formatting.

I have looked at other peoples code to convert text to HTML and it DOES exist but its several thousands lines of code and I don't think my boss wants me to turn in other peoples code for this sort of assessment type of project. (The reason I'm using the Replace method which only accepts strings is because I could find no other way of inserting text in the MIDDLE part of a MailItem.Body) I placed 3 "Flags" into the email template where I want the insertions to be. (The place holders ARE being placed in the right spot so I have that going for me..)

I also for see having problems making some of the list items become hyperlinks using this method. The list is dynamic so I can't hard code the links but I'll cross that bridge when I come to it I suppose. (The URL is included in the excel sheet on a different column)

My 2nd approach was the write the code in Outlook VBA on start up and pull the data from which ever source worked better (Excel or Sharepoint)

Public Sub Application_Startup()

'This isn't working but I'm not concerned with it at the moment
'Dim today As String
'today = Format(Now(), "MM/DD/YYYY")
'Dim later As String
'later = "11/11/2015"

'---initialize Excel Objects---
Const sourcePath As String = "This is a path to the excel sheet--it works but I removed it for this post"
Dim xlWB As Excel.Workbook
Dim xlRequisition As Excel.Worksheet
Dim xlTransfers As Excel.Worksheet
Dim xlAttritions As Excel.Worksheet
'Set Excel Objects
Excel.Workbooks.Open (sourcePath)
Set xlWB = Excel.ActiveWorkbook
Set xlRequisitions = xlWB.Worksheets("owssvr ReqList")
Set xlTransfers = xlWB.Worksheets("owssvr Transfer")
Set xlAttritions = xlWB.Worksheets("owssvr Attrit")
'----------------------------------
xlRequisitions.Activate
Dim lner As Long
lner = LastNonEmptyRow(Range("A:A"))
'Range("A2:N" & Trim(Str(lner))).AutoFilter Field:=3, Criteria1:=">=" & Format(today, "MM/DD/YYYY"), Operator:=xlAnd, Criteria2:="<" & Format(later, "MM/DD/YYYY")
Range("A2:N" & Trim(Str(lner))).Copy
End Sub

Function LastNonEmptyRow(r As Range) As Long
LastNonEmptyRow = r.Cells.Count - WorksheetFunction.CountBlank(r)
End Function

This method has gotten me a little less far.. The table DOES remain formatted in the clipboard and I can simply force the keystroke using the SendKeys method to hit ^v.. However this does not allow me to place it at the 3 "insertion points". (There is text before, after, and between each point). As far as I know you are unable to "move cursor" in VBA. In desperation my mind has gone to starting with a blank email and printing all the formatted contents of the email template piece by piece. I hope it doesn't come to that.

Other approaches I have yet to try but am not extremely hopeful about..

Use a MS Word document as an intermediary place to hold the tables/email body. Possibly this will allow me to have everything in one place and Word MIGHT have some method of moving the cursor around to place tables where you actually want them. I don't know though.

Another method that sounds a little more promising but I wouldn't know how to do is find a way to use the URL and listID number on Sharepoint to some how move this data directly.. More closely mimicking how my boss is doing it manually.

Answer 1

Sounds like you have 2 problems both of which are already answered on SO, but I'll try answering here since you are a new member. In the future I recommend that you ask separate questions both on SO and when debugging in general.

1. How to modify an Outlook template.

Send an email from Excel 2007 VBA using an Outlook Template & Set Variables

The key here is that e-mails are either plain text or HTML (or Rich Text which no one uses). In order to insert a formatted table you will have to:

A. Convert the table to HTML (see below)

B. Convert the template to HTML (just open it, change the Format under the Format Text tab and save it)

C. Insert the text using .HTMLBody = Replace() described in the link above

2. Converting an Excel range to HTML

You actually don't need a third party app to do this - it's built into Excel. See: Paste specific excel range in outlook