用VBA中的表格生成完全格式化的电子邮件
我有几个信息的工作。
- Outlook电子邮件模板带有一个自动化的消息和3个“插入点”，我需要一个整齐的格式化的表，包含超链接给我注入并发送到保存的分发列表。
- 一张Excel电子表格，带有3张表格，自动更新所有需要在表格中的信息（但不包含超链接）。
- 3个已过滤的Sharepoint列表，其中包含需要在表中的所有信息，并包含所需的超链接。
无论如何，我需要做一个简单的（比打开文件和复制和粘贴更容易）的方法自动生成一个格式化的电子邮件与所有上面列出的信息。 我是一名实习生，所以这是对我的能力的一种考验，而不是个人的节省时间，所以偏离要求并不是真正的select。 到目前为止，我的老板正在打开电子邮件模板，然后逐个打开Sharepoint列表，单击并拖动select，并单独复制和粘贴每个列表。 所以让我先从我尝试过的方法开始，然后继续前进到墙壁上。
所以我第一次尝试在源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 我遇到的这种方法的问题显然是当我将DataObject转换为string，我失去了表的所有格式。 （它被放置为由空格分隔的Excel值的长string）有像http://tableizer.journalistopia.com/在线资源我将用于将文本转换为HTML表格（如果它是我）但再次..我是一个实习生，任务是自动化，所以这就是我必须做的。 所以我需要以某种方式保持表格格式。
我已经看过其他人的代码，将文本转换为HTML，但它存在，但它的几千行代码，我不认为我的老板要我在其他人民的代码这种评估types的项目。 （我使用只接受string的Replace方法的原因是因为我找不到在MailItem.Body的MIDDLE部分中插入文本的其他方式）我在需要插入的电子邮件模板中放置了3个“标志”成为。 （地方持有人被放置在正确的位置，所以我有这个去为我..）
我也看到有问题使一些列表项成为超链接使用这种方法。 名单是dynamic的，所以我不能硬编码的链接，但我会穿过那座桥，当我来到它，我想。 （该URL包含在另一列的Excel表中）
我的第二种方法是在启动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
这种方法已经让我less了一点..表格仍然保持格式化在剪贴板，我可以简单地强制使用SendKeys方法击键^ v ..但是，这不允许我把它放在3“插入点”。 （每个点之前，之后和之间有文本）。 据我所知你无法在VBA中“移动光标”。 无奈之下，我的脑海里已经开始了一个空白的电子邮件，并逐一打印所有电子邮件模板的格式化内容。 我希望不会这样。
其他的方法，我还没有尝试，但我不是非常有希望的..
使用MS Word文档作为中间位置来容纳表/电子邮件正文。 也许这可以让我把所有的东西放在一个地方，Word MIGHT有一些移动光标的方法来放置你真正需要的表格。 虽然我不知道。
另一种听起来更有希望的方法，但我不知道该怎么做是find一种方法来使用Sharepoint上的URL和listID号码，以便如何直接移动这些数据..更贴近地模仿我的老板是如何手动做的。
听起来好像你有两个问题，这两个问题已经在这个问题上得到解答，但是我会尽力回答，因为你是一个新成员。 在将来，我build议你在SO和一般debugging时分别提出问题。
- 如何修改Outlook模板。
使用Outlook模板和设置variables从Excel 2007 VBA发送电子邮件
这里的关键是电子邮件是纯文本或HTML（或任何人使用的富文本）。 为了插入一个格式化的表，你将不得不：
A.将表格转换为HTML（见下文）
B.将模板转换为HTML（只需打开它，在格式文本选项卡下更改格式并保存）
C.使用上面链接中描述的.HTMLBody = Replace（）插入文本
- 将Excel范围转换为HTML
您实际上不需要第三方应用程序来执行此操作，而是将其内置到Excel中。 请参阅： 在Outlook中粘贴特定的Excel范围