Excel打开时自动发送带列表邮件的VBA换行问题求助

当用Outlook的HTMLBody设置邮件内容时，VBA的vbNewLine、vbLf这类换行符在HTML语法里不生效，必须用HTML专属的标签来实现换行或分段：

• 用<br>标签实现强制换行
• 用<p>标签包裹段落，可生成带上下间距的规范分段

另外你的代码还有两处细节问题需要修正：

1. 生成表格时Cells(i, j)未指定工作表，可能会错误引用当前激活的工作表，应改为rng.Cells(i, j).Value
2. 最后释放对象时Set xOutAp = Nothing是笔误，正确应为Set xOutApp = Nothing

修改后的完整代码如下：

Private Sub Auto_Open()
    Dim rng As Range
    Set rng = Worksheets("Munka2").Range("B3")
    If rng.Value <> "" Then
        Call SendMail
    End If
End Sub

Sub SendMail()
    Dim rng As Range, HtmlContent As String, i As Long, j As Long
    Set rng = Worksheets("Munka2").Range("A1").CurrentRegion
    
    HtmlContent = "<table>"
    For i = 2 To rng.Rows.Count
        HtmlContent = HtmlContent & "<tr>"
        For j = 1 To rng.Columns.Count
            HtmlContent = HtmlContent & "<td>" & rng.Cells(i, j).Value & "</td>"
        Next j
        HtmlContent = HtmlContent & "</tr>"
    Next i
    HtmlContent = HtmlContent & "</table>"
    
    Dim xOutApp As Object
    Dim xOutMail As Object
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    
    With xOutMail
        .To = "x.y@sample.hu"
        .CC = ""
        .BCC = ""
        .Subject = "Teljesítmény lekötés értesítő"
        '用<br>替换vbNewLine实现换行，添加额外<br>可增大间距
        .HTMLBody = "Sziasztok<br>" & _
                    "Az alábbi fogyasztási helyeken a elkötött teljesítményt legyetek szívesek ellenőrízni<br><br>" & _
                    HtmlContent & "<br><br>" & _
                    "Köszönettel<br>" & _
                    "Laci"
        .Save
        .Display
        '.Send
    End With
    
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

如果想要更美观的排版，推荐用<p>标签包裹段落，自动生成上下间距：

.HTMLBody = "<p>Sziasztok</p>" & _
            "<p>Az alábbi fogyasztási helyeken a elkötött teljesítményt legyetek szívesek ellenőrízni</p>" & _
            HtmlContent & _
            "<p>Köszönettel<br>Laci</p>"

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