粘贴前可能需要设置x。x = doc.Range.End - 1将查找文档末尾减1的位置

Sub SendEmailWithRange()
    Dim MyRange As Range
    Dim doc As Object
    
    Set MyRange = Sheets("Sheet1").Range("A4").CurrentRegion
    
    With CreateObject("outlook.application").CreateItem(0)
        .Display                                 'Change to .Send to send the email immediately
        
        .Body = "This is the body:"              '& vbNewLine & vbNewLine
        Set doc = .GetInspector.WordEditor
        
        x = doc.Range.End - 1
        MyRange.Copy
        doc.Range(x).Paste
            
        .To = Range("I3").Value
        .Subject = "My subject"
        
        Application.CutCopyMode = 0
    End With
    
End Sub

在正文底部添加更多行

Sub SendEmailWithRange()
    Dim MyRange As Range
    Dim doc As Object
    
    Set MyRange = Sheets("Sheet1").Range("A4").CurrentRegion
    
    With CreateObject("outlook.application").CreateItem(0)
        .Display                                 'Change to .Send to send the email immediately
        
        .Body = "This is the body:"              '& vbNewLine & vbNewLine
        Set doc = .GetInspector.WordEditor
        
        x = doc.Range.End - 1
        MyRange.Copy
        doc.Range(x).Paste
            
        x = doc.Range.End - 1
        doc.Range(x) = "More Stuff"              'add more stuff
        
        x = doc.Range.End - 1
        doc.Range(x) = vbNewLine & "Even More Stuff" 'add more stuff with New line
        
        x = doc.Range.End - 1
        doc.Range(x) = vbNewLine & vbNewLine & vbNewLine & _
                       "Even More Stuff"         'add more stuff with multi-line breaks
        
        .To = Range("I3").Value
        .Subject = "My subject"
        
        Application.CutCopyMode = 0
    End With
    
End Sub