Outlook邮件VBA添加双边框表格异常：嵌套无边框且换行错误

问题现象 #

尝试在Outlook邮件中通过VBA添加两个带边框的独立表格，但运行后出现以下问题：

• 第二个表格被嵌套进第一个表格内部
• 表格未显示完整边框
• 调用selection.TypeParagraph时，换行始终添加在表格内部而非表格前后

运行效果截图：

原代码：

myitem.Display

Set ins = oOutlook.ActiveInspector

Set document = ins.WordEditor
Set Word = document.Application
Set selection = Word.selection

selection.TypeText Text:="Dear Requester,"
selection.TypeParagraph
selection.TypeParagraph

With selection
    .Font.Bold = True
End With
selection.TypeText Text:="Please confirm that quotation of chosen vendor is suitable before proceeding with PR creation."
selection.TypeParagraph
selection.TypeParagraph

'add table here
Set objTable = selection.Tables.Add(Range:=selection.Range, NumRows:=3, NumColumns:=2)
objTable.Borders.OutsideLineStyle = wdLineStyleSingle
objTable.Borders.OutsideLineWidth = wdLineWidth150pt
objTable.Borders.OutsideColor = wdColorBlack

objTable.Cell(1, 1).Range.Text = "Initial quote :"
objTable.Cell(1, 2).Range.Text = " "
objTable.Cell(2, 1).Range.Text = "Discount rate :"
objTable.Cell(2, 2).Range.Text = ""
objTable.Cell(3, 1).Range.Text = "Final quote :"
objTable.Cell(2, 2).Range.Text = ""

selection.TypeParagraph
selection.TypeParagraph

Set objTable2 = selection.Tables.Add(Range:=selection.Range, NumRows:=2, NumColumns:=2)
objTable2.Borders.OutsideLineStyle = wdLineStyleSingle
objTable2.Borders.OutsideLineWidth = wdLineWidth150pt
objTable2.Borders.OutsideColor = wdColorBlack

objTable2.Cell(1, 1).Range.Text = "Last spend on year 2020 :"
objTable2.Cell(1, 2).Range.Text = " "
objTable2.Cell(2, 1).Range.Text = "Incremental increase percentage :"
objTable2.Cell(2, 2).Range.Text = ""

修改后的代码 #

myitem.Display

Set ins = oOutlook.ActiveInspector

Set document = ins.WordEditor
Set Word = document.Application
Set selection = Word.selection

' 写入开头文本
selection.TypeText Text:="Dear Requester,"
selection.TypeParagraph
selection.TypeParagraph

With selection
    .Font.Bold = True
End With
selection.TypeText Text:="Please confirm that quotation of chosen vendor is suitable before proceeding with PR creation."
selection.TypeParagraph
selection.TypeParagraph

' 创建第一个表格
Set objTable = selection.Tables.Add(Range:=selection.Range, NumRows:=3, NumColumns:=2)
' 设置内外边框样式
With objTable.Borders
    .InsideLineStyle = wdLineStyleSingle
    .InsideLineWidth = wdLineWidth150pt
    .InsideColor = wdColorBlack
    .OutsideLineStyle = wdLineStyleSingle
    .OutsideLineWidth = wdLineWidth150pt
    .OutsideColor = wdColorBlack
End With
' 填充表格内容
objTable.Cell(1, 1).Range.Text = "Initial quote :"
objTable.Cell(1, 2).Range.Text = " "
objTable.Cell(2, 1).Range.Text = "Discount rate :"
objTable.Cell(2, 2).Range.Text = ""
objTable.Cell(3, 1).Range.Text = "Final quote :"
objTable.Cell(3, 2).Range.Text = "" ' 修正原代码的单元格索引错误

' 将光标移动到第一个表格末尾，添加换行
objTable.Range.Select
selection.Collapse Direction:=wdCollapseEnd
selection.TypeParagraph
selection.TypeParagraph

' 创建第二个表格
Set objTable2 = selection.Tables.Add(Range:=selection.Range, NumRows:=2, NumColumns:=2)
' 设置内外边框样式
With objTable2.Borders
    .InsideLineStyle = wdLineStyleSingle
    .InsideLineWidth = wdLineWidth150pt
    .InsideColor = wdColorBlack
    .OutsideLineStyle = wdLineStyleSingle
    .OutsideLineWidth = wdLineWidth150pt
    .OutsideColor = wdColorBlack
End With
' 填充表格内容
objTable2.Cell(1, 1).Range.Text = "Last spend on year 2020 :"
objTable2.Cell(1, 2).Range.Text = " "
objTable2.Cell(2, 1).Range.Text = "Incremental increase percentage :"
objTable2.Cell(2, 2).Range.Text = ""

' 可选：将光标移动到第二个表格末尾，方便后续编辑
objTable2.Range.Select
selection.Collapse Direction:=wdCollapseEnd

关键修改点说明 #

1. 修正光标位置问题：
   创建表格后，默认光标会停留在表格内部，直接调用TypeParagraph会在表格内生成新行。通过objTable.Range.Select选中整个表格，再用selection.Collapse Direction:=wdCollapseEnd将光标折叠到表格末尾，此时添加的段落会出现在表格外部，避免第二个表格嵌套。

2. 补全边框设置：
   原代码仅设置了表格外边框，添加.InsideLineStyle、.InsideLineWidth、.InsideColor属性，让表格内外都显示完整边框。

3. 修复单元格索引错误：
   原代码中重复给objTable.Cell(2, 2)赋值，将其改为objTable.Cell(3, 2)，确保第三行第二列的单元格被正确赋值。

内容的提问来源于stack exchange，提问作者Elsie Ling