从 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 Range 等。例如

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 列表，但由于需要声明 Word 和 Outlook 对象并解决它们之间的关系，因此在编码方面会产生一定的乏味。

看来我在原始代码中错误地声明了我的 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 文字编辑器中选择所有文本，然后按原样粘贴将其分配给剪贴板，或者如果在将其放入剪贴板之前需要进行其他更改，则将其分配给变量。