将 PowerPoint 原生 table 复制到 Outlook 电子邮件的正文

Question

我无法提供所有代码。它来自我公司的一个内部项目。

我创建了 VBA 代码以从 Excel 列表中获取元素并将其保存在 PowerPoint 本地 table（尺寸：7 行，6 列，名称：Table1)，它已经在 PowerPoint 模板文件中创建。该代码仅在正确的单元格中填充正确的数据。

'Example of how I access the native table in PowerPoint        
Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Table1")

'I can get data from a cell by using, for example: 
oPPTShape.Table.Cell(2, 1).Shape.TextFrame.TextRange.Text
'But I cannot select a range from this PowerPoint table

我想从 PowerPoint 中提取本机 table 并将其粘贴到 Outlook 电子邮件的正文中。我读到也许我可以通过在 OutMail 内部使用 .HTMLBody = StrBody & RangetoHTML(rng) 来做到这一点，如下所述：

With OutMail                    

  .To = name_email                                       
  'Add file                    
  .Attachments.Add ("C:... .pptx")                    
  .Subject = "Data"                    
  .Body = StrBody                    
  .HTMLBody = StrBody & RangetoHTML(rng)                    
  .SaveAs "C:... .msg", 5                    
  .Display  'Or use .Send          

End With

其中 rng 是将从电子邮件正文中的 Table1 复制的范围。

到目前为止，我可以将 PowerPoint Table1 中的数据与下面的代码一起使用，并且我尝试使用相同的方法在电子邮件正文中插入 Table1。

Dim strNewPresPath As String    
strNewPresPath = "C:\... .pptx"    

Set oPPTApp = CreateObject("PowerPoint.Application")    
oPPTApp.Visible = msoTrue   

Set oPPTFile = oPPTApp.Presentations.Open(strNewPresPath)    
SlideNum = 1    

Sheets("Open Tasks").Activate  

Dim myStr As String    
myStr = "Open"

Do        
  oPPTFile.Slides(SlideNum).Select          
  'Select PowerPoint shape with the name Table1        
  Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Table1")
.
.
.

我的问题是：

是否有其他方法可以使用 VBA 代码将此 Table1 从 PowerPoint 复制并粘贴到电子邮件正文？

它可以是 Table 中的 Image/Picture，甚至可以与 PowerPoint 中的格式完全不同，因为直到现在我都将它作为附件发送，我相信当 Table 在电子邮件中的文本下方可见时，它更容易阅读。

Answer 1

这是一个基本示例，它将使用 PowerPoint Table 并使用早期绑定将其复制到 Outlook 电子邮件中。

请记住，这有时可能是不稳定的，换句话说，信息实际上并没有进入剪贴板，但这可以通过暂停应用程序几秒钟来解决。此外，如果 Outlook 已经打开，这将起作用。

Sub ExportToOutlook()

'Declare PowerPoint Variables
 Dim PPTShape As PowerPoint.Shape

'Declare Outlook Variables
 Dim oLookApp As Outlook.Application
 Dim oLookItm As Outlook.MailItem

    'Create a reference to the table you want to copy, & select it.
    Set PPTShape = ActivePresentation.Slides(1).Shapes("Table 1")
        PPTShape.Select

        On Error Resume Next

        'Test if Outlook is Open
        Set oLookApp = GetObject(, "Outlook.Application")

            'If the Application isn't open it will return a 429 error
            If Err.Number = 429 Then

              'If it is not open then clear the error and create a new instance of Outlook
               Err.Clear
               Set oLookApp = New Outlook.Application

            End If

        'Create a mail item in outlook.
        Set oLookItm = oLookApp.CreateItem(olMailItem)

        'Copy the table
        PPTShape.Copy

        'Create the Outlook item
         With oLookItm

             'Pass through the necessary info
             .To = "Someone"
             .Subject = "Test"
             .Display

             'Get the word editor
              Set oLookInsp = .GetInspector
              Set oWdEditor = oLookInsp.WordEditor

             'Define the content area
              Set oWdContent = oWdEditor.Content
              oWdContent.InsertParagraphBefore

             'Define the range where we want to paste.
              Set oWdRng = oWdEditor.Paragraphs(1).Range

             'Paste the object.
              oWdRng.Paste

    End With




End Sub

将 PowerPoint 原生 table 复制到 Outlook 电子邮件的正文

Copy PowerPoint native table to the body of an Outlook Email

excel

outlook

powerpoint

vba