Question

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

我创建了VBA代码以从Excel列表中获取元素并将其保存在PowerPoint本机表（尺寸：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中提取此本机表并将其粘贴到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代码从PowerPoint复制此Table1并将其粘贴到电子邮件的正文中？

它可以作为表格中的图像/图片，甚至可以不与PowerPoint中的格式完全相同，因为到目前为止，我将其作为附件发送，并且我相信在表格中阅读起来更容易在电子邮件中的文字下方可见。

Answer 1

这是一个基本示例，它将使用PowerPoint表格并将其使用早期绑定复制到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本机表复制到Outlook电子邮件的正文中

1 个答案: