将 Excel 范围粘贴到 Outlook 电子邮件中

Question

我正在尝试将一组单元格区域粘贴到文档中。

我尝试了不同的代码并观看了教程。

除了粘贴到电子邮件之外，此代码似乎可以执行所有操作。
如果我手动粘贴最后一个复制的单元格区域，它似乎会复制该区域。

Sub RangeToOutlook_Multi()

    'Declare Outlook Variables
    Dim oLookApp As Outlook.Application
    Dim oLookItm As Outlook.MailItem
    Dim oLookIns As Outlook.Inspector
    
    'Declare Word Variables
    Dim oWrdDoc As Word.Document
    Dim oWrdRng As Word.Range
    
    'Delcare Excel Variables
    Dim RngArray As Variant
    
    On Error Resume Next
    
    'Get the Active instance of Outlook if there is one
    Set oLookApp = GetObject(, "Outlook.Application")
    'If Outlook isn't open then create a new instance of Outlook
    If Err.Number = 429 Then
        'Clear Error
        Err.Clear
        'Create a new instance of Outlook
        Set oLookApp = New Outlook.Application
    End If
        
    'Create a new email
    Set oLookItm = oLookApp.CreateItem(olMailItem)
    
    'Create an array to hold ranges
    RngArray = Array(Sheet6.Range("A101:E112"), Sheet6.Range("G101:K111"))

    With oLookItm
        'Define some basic info of our email
        .To = "xyz@abc.com"
        .CC = "xyz@abc.com"
        .Subject = "Here are all of my Ranges"
        .Body = "Here are all the Ranges from my worksheet."

        'Display the email
        .Display
        
        'Get the Active Inspector
        Set oLookIns = .GetInspector
        
        'Get the document within the inspector
        Set oWrdDoc = oLookIns.WordEditor
        
      For Each Item In RngArray
            Item.Copy
            
            'Define the range, insert a blank line, collapse the selection.
            Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content
            oWrdRng.Collapse Direction:=wdCollapseEnd
                
            'Add a new paragragp and then a break
            Set oWrdRng = oWdEditor.Paragraphs.Add
            oWrdRng.InsertBreak
                        
            'Paste the object.
            oWrdRng.PasteSpecial DataType:=wdPasteMetafilePicture
        Next
    End With
End Sub

Answer 1

在代码中，oWrdRng 对象在循环中被覆盖：

 For Each Item In RngArray
        
            Item.Copy
            
            'Define the range, insert a blank line, collapse the selection.
            Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content
                oWrdRng.Collapse Direction:=wdCollapseEnd
                
            'Add a new paragragp and then a break
            Set oWrdRng = oWdEditor.Paragraphs.Add
            oWrdRng.InsertBreak
                        
            'Paste the object.
            oWrdRng.PasteSpecial DataType:=wdPasteMetafilePicture
        
     Next

Document.Paragraphs 属性返回代表指定文档中所有段落的Paragraphs 集合。因此，您似乎需要通过以下方式更改代码：

 For Each Item In RngArray
        
            Item.Copy
            
            'Define the range, insert a blank line, collapse the selection.
            Set oWrdRng = oWrdDoc.Content
            oWrdRng.Collapse Direction:=wdCollapseEnd
                
            'Add a new paragragp and then a break
            Set oWrdRng = oWrdDoc.Paragraphs.Add
            oWrdRng.InsertBreak
                        
            'Paste the object.
            oWrdRng.PasteSpecial DataType:=wdPasteMetafilePicture
        
     Next

最后，如果某些东西不能正常工作，我建议先调试代码，这样如果出现意外失败，您可以参考特定的代码行。