使用 VBA 中的表格生成完全格式化的电子邮件
Generate a fully formatted email with tables in VBA
我有几条信息要处理。
- 一个带有自动消息和 3 "insertion points" 的 outlook 电子邮件模板，我需要一个格式整洁的 table，其中包含注入我的超链接并发送到保存的通讯组列表。
- Master Excel spread sheet with 3 sheets which is auto updated with all the info needed in the tables (but does not contain超链接）。
- 3 个过滤的 Sharepoint 列表，其中包含 table 中需要的所有信息，并且包含所需的超链接。
不管怎样，我需要一种简单的方法（比打开两个文件并复制和粘贴更容易）自动生成包含上述所有信息的格式化电子邮件。我是一名实习生，所以这与其说是为了节省个人时间，不如说是对我能力的考验，所以偏离要求并不是一个真正的选择。到目前为止，我的老板正在打开电子邮件模板，然后一个接一个地打开 Sharepoint 列表，单击并拖动一个选择，然后分别复制和粘贴每个列表。因此，让我从我尝试过的方法开始，然后继续我遇到的问题。
所以我的第一次尝试是在源 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 转换为字符串时，我丢失了 table 的所有格式。 （它被放置为由空格分隔的 excel 值的长字符串）有像 http://tableizer.journalistopia.com/ 这样的在线资源，我会用它来将文本转换为 HTML table （如果是我的话）但又一次……我是一名实习生，任务是将其自动化，所以这就是我必须做的。所以我需要以某种方式让它保持 table 格式。
我看过其他人将文本转换为 HTML 的代码，它确实存在，但它有几千行代码，我认为我的老板不希望我为此交出其他人的代码某种评估类型的项目。 （我使用仅接受字符串的 Replace 方法的原因是因为我找不到在 MailItem.Body 的中间部分插入文本的其他方法）我将 3 "Flags" 放入电子邮件模板中我希望插入是。 （占位符被放置在正确的位置所以我有那个适合我..）
我还发现使用此方法使某些列表项成为超链接时出现问题。该列表是动态的，所以我不能对链接进行硬编码，但我想当我到达它时我会穿过那座桥。 （URL 包含在 excel sheet 的不同列中）
我的第二种方法是在启动时在 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
这个方法让我有点不那么远了。table 确实在剪贴板中保留了格式，我可以简单地使用 SendKeys 方法强制击键以点击 ^v..但是这不允许我把它放在 3 "insertion points"。 （每个点之前、之后和之间都有文字）。据我所知，您无法在 VBA 中 "move cursor"。无奈之下，我的想法是从一封空白电子邮件开始，逐条打印电子邮件模板的所有格式化内容。希望不要发展到那个地步。
我还没有尝试过但不是很有希望的其他方法..
使用 MS Word 文档作为放置 tables/email 正文的中间位置。可能这将允许我将所有内容都放在一个地方，并且 Word 可能有一些方法可以移动光标以将 tables 放置在您真正想要的位置。虽然我不知道。
另一种听起来更有希望但我不知道该怎么做的方法是找到一种方法来使用 Sharepoint 上的 URL 和 listID 编号来直接移动这些数据..更紧密模仿我的老板是如何手动完成的。
听起来你有 2 个问题，这两个问题都已在 SO 上得到解答，但我会尝试在这里回答，因为你是新成员。以后我建议你在 SO 和一般调试时分别提出问题。
- 如何修改 Outlook 模板。
Send an email from Excel 2007 VBA using an Outlook Template & Set Variables
这里的关键是电子邮件要么是纯文本，要么是 HTML（或没有人使用的 Rich Text）。要插入格式化的 table，您必须：
一个。将 table 转换为 HTML（见下文）
乙。将模板转换为HTML（打开它，在格式文本选项卡下更改格式并保存）
C.使用上面 link 中描述的 .HTMLBody = Replace() 插入文本
- 将 Excel 范围转换为 HTML
您实际上不需要第三方应用程序来执行此操作 - 它内置于 Excel。参见：Paste specific excel range in outlook
我有几条信息要处理。
- 一个带有自动消息和 3 "insertion points" 的 outlook 电子邮件模板，我需要一个格式整洁的 table，其中包含注入我的超链接并发送到保存的通讯组列表。
- Master Excel spread sheet with 3 sheets which is auto updated with all the info needed in the tables (but does not contain超链接）。
- 3 个过滤的 Sharepoint 列表，其中包含 table 中需要的所有信息，并且包含所需的超链接。
不管怎样，我需要一种简单的方法（比打开两个文件并复制和粘贴更容易）自动生成包含上述所有信息的格式化电子邮件。我是一名实习生，所以这与其说是为了节省个人时间，不如说是对我能力的考验，所以偏离要求并不是一个真正的选择。到目前为止，我的老板正在打开电子邮件模板，然后一个接一个地打开 Sharepoint 列表，单击并拖动一个选择，然后分别复制和粘贴每个列表。因此，让我从我尝试过的方法开始，然后继续我遇到的问题。
所以我的第一次尝试是在源 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 转换为字符串时，我丢失了 table 的所有格式。 （它被放置为由空格分隔的 excel 值的长字符串）有像 http://tableizer.journalistopia.com/ 这样的在线资源，我会用它来将文本转换为 HTML table （如果是我的话）但又一次……我是一名实习生，任务是将其自动化，所以这就是我必须做的。所以我需要以某种方式让它保持 table 格式。
我看过其他人将文本转换为 HTML 的代码，它确实存在，但它有几千行代码，我认为我的老板不希望我为此交出其他人的代码某种评估类型的项目。 （我使用仅接受字符串的 Replace 方法的原因是因为我找不到在 MailItem.Body 的中间部分插入文本的其他方法）我将 3 "Flags" 放入电子邮件模板中我希望插入是。 （占位符被放置在正确的位置所以我有那个适合我..）
我还发现使用此方法使某些列表项成为超链接时出现问题。该列表是动态的，所以我不能对链接进行硬编码，但我想当我到达它时我会穿过那座桥。 （URL 包含在 excel sheet 的不同列中）
我的第二种方法是在启动时在 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
这个方法让我有点不那么远了。table 确实在剪贴板中保留了格式，我可以简单地使用 SendKeys 方法强制击键以点击 ^v..但是这不允许我把它放在 3 "insertion points"。 （每个点之前、之后和之间都有文字）。据我所知，您无法在 VBA 中 "move cursor"。无奈之下，我的想法是从一封空白电子邮件开始，逐条打印电子邮件模板的所有格式化内容。希望不要发展到那个地步。
我还没有尝试过但不是很有希望的其他方法..
使用 MS Word 文档作为放置 tables/email 正文的中间位置。可能这将允许我将所有内容都放在一个地方，并且 Word 可能有一些方法可以移动光标以将 tables 放置在您真正想要的位置。虽然我不知道。
另一种听起来更有希望但我不知道该怎么做的方法是找到一种方法来使用 Sharepoint 上的 URL 和 listID 编号来直接移动这些数据..更紧密模仿我的老板是如何手动完成的。
听起来你有 2 个问题，这两个问题都已在 SO 上得到解答，但我会尝试在这里回答，因为你是新成员。以后我建议你在 SO 和一般调试时分别提出问题。
- 如何修改 Outlook 模板。
Send an email from Excel 2007 VBA using an Outlook Template & Set Variables
这里的关键是电子邮件要么是纯文本，要么是 HTML（或没有人使用的 Rich Text）。要插入格式化的 table，您必须：
一个。将 table 转换为 HTML（见下文）
乙。将模板转换为HTML（打开它，在格式文本选项卡下更改格式并保存）
C.使用上面 link 中描述的 .HTMLBody = Replace() 插入文本
- 将 Excel 范围转换为 HTML
您实际上不需要第三方应用程序来执行此操作 - 它内置于 Excel。参见：Paste specific excel range in outlook