如何在从Excel导入Outlook的两张图片之间添加换行

原代码的问题在于两次都将图片粘贴到邮件正文的起始位置，且未插入段落分隔，导致图片并排显示。以下是修改后的代码，实现两张图片上下排列，且中间添加空白行：

Sub CopyRngToOutlook2()
    Dim doc As Object, rng1 As Range, rng2 As Range
    Dim wb1 As Workbook, wb2 As Workbook ' 新增工作簿变量，用于后续关闭
    
    ' 打开工作簿并指定区域，同时保存工作簿对象
    Set wb1 = Workbooks.Open(FileName:="V:\CUSTOMER SERVICE\06. PERFORMANCE BOARD\Performance Board BIDI BELUX-V7.xlsx")
    Set rng1 = wb1.Sheets("Hoofdscherm").Range("B3:F23")
    
    Set wb2 = Workbooks.Open(FileName:="V:\SUPPLY CHAIN TEAM\08. STOCKOPVOLGING\AnalyseVolledigeStock2023-2024.xlsm")
    Set rng2 = wb2.Sheets("Ordermix Oude stock").Range("D2:G23")
 
    With CreateObject("Outlook.Application").CreateItem(0)
        .Display
        Set doc = .GetInspector.WordEditor
        
        ' 粘贴第一张图片到正文起始位置
        rng1.CopyPicture
        doc.Range(0, 0).Paste
        
        ' 插入两个段落分隔：一个用于图片下方换行，一个作为空白行
        doc.Range(doc.Content.End - 1, doc.Content.End - 1).InsertAfter vbCrLf & vbCrLf
        
        ' 粘贴第二张图片到正文末尾
        rng2.CopyPicture
        doc.Range(doc.Content.End - 1, doc.Content.End - 1).Paste
        
        .To = "someone@somewhere.com"
        .Subject = "Send Email Body"
        '.send
    End With
    
    ' 关闭打开的工作簿，不保存（如果需要保存可改为True）
    wb1.Close SaveChanges:=False
    wb2.Close SaveChanges:=False
    
    ' 释放对象
    Set rng1 = Nothing
    Set rng2 = Nothing
    Set wb1 = Nothing
    Set wb2 = Nothing
    Set doc = Nothing
End Sub

关键修改说明： #

• 新增工作簿变量，操作完成后关闭打开的文件，避免资源占用
• 粘贴第一张图片后，通过InsertAfter vbCrLf & vbCrLf插入两个换行，实现图片下方的空白行
• 第二张图片粘贴到正文末尾（doc.Range(doc.Content.End - 1, doc.Content.End - 1)），确保在第一张图片下方显示
• 添加对象释放语句，优化内存使用

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