使用 VBA 中的表格生成完全格式化的电子邮件

Generate a fully formatted email with tables in VBA

提问by Riggy

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.

1. 一个带有自动消息和 3 个“插入点”的 Outlook 电子邮件模板，我需要一个整洁的格式化表格，其中包含指向我的超链接注入并发送到保存的分发列表。
2. 一个包含 3 个工作表的主 Excel 电子表格，它会自动更新表格中所需的所有信息（但不包含超链接）。
3. 3 个过滤的 Sharepoint 列表，其中包含表中所需的所有信息，并且包含所需的超链接。

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.

一种或另一种方式，我需要一种简单的（比打开文件和复制粘贴更容易）方法来自动生成带有上述所有信息的格式化电子邮件。我是一名实习生，所以这既是对我能力的考验，也不是为了节省个人时间，因此偏离要求并不是真正的选择。到目前为止，我的老板正在打开电子邮件模板，然后一个一个打开 Sharepoint 列表，单击并拖动一个选择，然后分别复制和粘贴每个列表。所以让我从我尝试过的方法开始，然后继续我遇到的问题。

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.

所以我的第一次尝试是在源 Excel 文件中工作并生成一封电子邮件，因为我之前已经通过一些更简单的自动化完成了这项工作。

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.

我使用这种方法遇到的问题显然是当我将 DataObject 转换为字符串时，我丢失了表格的所有格式。（它被放置为一长串由空格分隔的 excel 值）有像http://tableizer.journalistopia.com/这样的在线资源，我会用它来将文本转换为 HTML 表格（如果是我的话）但是再次..我是一名实习生，任务是自动化，这就是我必须做的。所以我需要某种方式让它保持表格格式。

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..)

我查看了其他人的代码以将文本转换为 HTML，它确实存在，但它有数千行代码，我认为我的老板不希望我为此类评估类型的项目提交其他人的代码。（我使用仅接受字符串的 Replace 方法的原因是因为我找不到在 MailItem.Body 的 MIDDLE 部分插入文本的其他方法）我将 3 个“标志”放入我想要插入的电子邮件模板中成为。（占位符被放置在正确的位置，所以我对我有那个意思..）

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)

我也看到了使用这种方法使某些列表项成为超链接的问题。该列表是动态的，因此我无法对链接进行硬编码，但我想当我来到它时我会越过那座桥。（该 URL 包含在不同列的 Excel 表中）

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)

我的第二种方法是在启动时在 Outlook VBA 中编写代码，并从哪个源工作得更好（Excel 或 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.

这种方法让我少了一点.. 表格在剪贴板中保持格式化，我可以简单地使用 SendKeys 方法强制击键击中 ^v .. 但是这不允许我将它放在 3" 插入点”。（每个点之前、之后和之间都有文本）。据我所知，您无法在 VBA 中“移动光标”。无奈之下，我的想法是从一封空白电子邮件开始，然后逐个打印电子邮件模板的所有格式化内容。我希望它不会到那个地步。

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.

使用 MS Word 文档作为中间位置来保存表格/电子邮件正文。可能这会让我把所有东西都放在一个地方，Word 可能会有一些方法来移动光标来放置你真正想要的表格。我不知道。

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.

另一种听起来更有希望但我不知道该怎么做的方法是找到一种方法来使用 Sharepoint 上的 URL 和 listID 号来直接移动这些数据..更接近地模仿我的老板是如何手动完成的。

采纳答案by Charlie

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.

听起来您有 2 个问题，这两个问题都已在 SO 上得到解答，但由于您是新成员，因此我会尝试在这里回答。将来，我建议您在 SO 和一般调试时提出单独的问题。

1. How to modify an Outlook template.

1. 如何修改 Outlook 模板。

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

使用 Outlook 模板和设置变量从 Excel 2007 VBA 发送电子邮件

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:

这里的关键是电子邮件要么是纯文本要么是 HTML（或没人使用的富文本）。为了插入格式化的表格，您必须：

A. Convert the table to HTML (see below)

A. 将表格转换为 HTML（见下文）

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

B. 将模板转换为HTML（只需打开它，更改Format Text选项卡下的Format并保存）

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

C. 使用上面链接中描述的 .HTMLBody = Replace() 插入文本

1. Converting an Excel range to HTML

2. 将 Excel 范围转换为 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

您实际上不需要第三方应用程序来执行此操作 - 它已内置于 Excel 中。请参阅：在 Outlook 中粘贴特定的 excel 范围