从 Excel VBA 在 Outlook 中创建多级列表

Question

我正在使用 excel 处理用户输入，然后根据输入输出标准化的电子邮件，然后将该格式化文本保存到一个变量中，以便稍后将其添加到剪贴板，以便于进入我们用于内部的系统文档。

我有一个使用 HTML 作为电子邮件格式的有效方法，但这并不能解决我的意图，因为它也复制了 HTML 标签，因此将代码复制到剪贴板或变量。 我希望获得 Word 项目符号列表的功能，因此我一直在尝试以一种可以按需调用的方式调整 MS Word 代码。

我目前已将 Word 和 Outlook 的默认 Excel 库、表单库和对象库添加到程序中。

我的目标是通过 Word 列表传递一个基于 Excel 表格的数组列表，并将其格式化并将文本写入 Outlook 草稿中的 Word 编辑器。 需要编写不同数量的部分（不超过 6 个），通常每个部分不超过 10 个项目，通常更少。 所以我打算让其他子/函数调用它来根据需要格式化每个部分。

附件是本节的输出示例，以及数据来源的示例。 每个部分在 Excel 中都有自己的工作表。 每个部分的列表的第二级将来自一个单独的工作表。

我包含了一部分实际代码，显示了新 Outlook 草稿的启动和文本输入。 EmailBody() 目前只处理这些部分之外的任何文本，并为每个部分调用一个单独的函数来解析表格（目前为无格式文本，仅输入换行符）。

输出示例

数据源示例

Sub Email()

   Dim eTo As String
   eTo = Range("H4").Value

   Dim myItem As Object
   Dim myInspector As Outlook.Inspector

   Dim wdDoc As Word.Document
   Dim wdRange As Word.Range

Set myItem = Outlook.Application.CreateItem(olMailItem)
With myItem
    .To = eTo
    .Bcc = "email"
    .Subject = CNum("pt 1") & " | " & CNum("pt 2")
    'displays message prior to send to ensure no errors in email. Autosend is possible, but not recommended.
    .Display

    Set myInspector = .GetInspector
    'Obtain the Word.Document for the Inspector
    Set wdDoc = myInspector.WordEditor

     If Not (wdDoc Is Nothing) Then
         Set wdRange = wdDoc.Range(0, wdDoc.Characters.Count)
         wdRange.InsertAfter (EmailBody(CNum("pt 1"), CNum("pt 2")))
     End If
'[...]
end with
end sub

多级列表代码我正在努力适应。 我一直在注释掉的代码部分出现错误，并且不确定如何正确更正它，以便它既可以运行又可以按需调用：

运行时错误“450”：参数数量错误或属性分配无效

Sub testList()

Dim arr1 As Object
Set arr1 = CreateObject("System.Collections.ArrayList")

With arr1
    .Add "test" & " $100"
    .Add "apple"
    .Add "four"
End With

Dim i As Long

 With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
    .NumberFormat = ChrW(61623)
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = wdListNumberStyleBullet
    .NumberPosition = InchesToPoints(0.25)
    .Alignment = wdListLevelAlignLeft
    .TextPosition = InchesToPoints(0.5)
    .TabPosition = wdUndefined
    .ResetOnHigher = 0
    .StartAt = 1
    .LinkedStyle = ""
End With
ListGalleries(wdBulletGallery).ListTemplates(1).Name = ""
'Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
'    ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
'    False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
'    wdWord10ListBehavior

    'writes each item in ArrayList to document
    For i = 0 To arr1.Count - 1
        Selection.TypeText Text:=arr1(i)
        Selection.TypeParagraph
    Next i
    'writes each item to level 2 list
    Selection.Range.SetListLevel Level:=2
    For i = 0 To arr1.Count - 1
        Selection.TypeText Text:=arr1(i)
        Selection.TypeParagraph
    Next i
Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph

arr1.Clear
End Sub

如果其中任何一个看起来效率低下或奇怪的方法，请原谅我。 几周前我真的开始学习 VBA 并且在我的工作职责和我迄今为止学到的知识之间只有几个小时的应用程序。 任何帮助将不胜感激。

Answer 1

您收到该错误的原因是，它无法解析对象Selection 。 您需要完全限定 Selection 对象，否则 Excel 将引用 Excel 中的当前选择。

您可能已经从 Excel 中引用了 Word 对象库，但这还不够。 重现此错误的最简单方法是从 Excel 运行它

Sub Sample()
    Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
    ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
    False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
    wdWord10ListBehavior
End Sub

这是一个可以工作的示例代码。 要对此进行测试，请打开一个 Word 文档并选择一些文本，然后从 Excel 中运行此代码

Sub Sample()
    Dim wrd As Object

    Set wrd = GetObject(, "word.application")

    wrd.Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
    ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
    False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= wdWord10ListBehavior
End Sub

将此应用于您的代码。 您需要使用 Word 对象并完全限定您的对象，如 Word 应用程序、Word 文档、Word 范围等。例如

Dim oWordApp As Object, oWordDoc As Object
Dim FlName As String

FlName = "C:\MyFile.Docx"

'~~> Establish an Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")

If Err.Number <> 0 Then
    Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0

oWordApp.Visible = True

Set oWordDoc = oWordApp.Documents.Open(FlName)

With oWordDoc
    '
    '~~> Rest of the code here
    '
End With

Answer 2

由于需要声明 Word 和 Outlook 对象并解析它们之间的关系，因此使用 Word 列表虽然在这种情况下起作用，但在编码过程中会产生一定的乏味。

看来我在原始代码中错误地声明了我的 HTML 列表。 我移动了<li>的边距而不是嵌套<ul>来步进列表。

通过嵌套 HTML 列表标签，您可以获得与单词列表相同的功能，并且在复制到其他文本编辑器时格式将保持不变。 但是，必须在写入 .HTMLBody 后进行复制。

<ul><li>Apple</li><ul><li>Fruit</li></ul></ul>

或对于 VBA：

.HTMLBody = "<ul><li>" & arg1 & "</li><ul><li>" & arg2 & "</li></ul></ul>"

以上将输出到 .HTMLBody：

• 苹果
• 水果

要复制文本，您只需要在 Outlook 文字编辑器中选择所有文本，然后按原样粘贴将其分配到剪贴板，或者如果在将其放入剪贴板之前需要进行其他更改，则将其分配给变量。