CODEWITHSUNDEEP
excelvbaoutlookpowerpoint
Gabriel
Gabriel

Reputation: 763

Copy PowerPoint native table to the body of an Outlook Email

I cannot provide all the code. It is from an internal project of my company.

I created VBA code to take elements from an Excel list and save it in a PowerPoint native table (dimensions: 7 rows, 6 columns, name: Table1), which is already created inside of the PowerPoint template file. The code only fills it with the correct data in the correct cells.

'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

I would like to extract this native table from PowerPoint and paste it in an Outlook email's body. I read that maybe I can do this by using .HTMLBody = StrBody & RangetoHTML(rng), inside of the OutMail as described below:

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

Where rng is the Range that will be copied from the Table1 inside of the email's body.

Until now I can use the data from PowerPoint Table1 with the code below and I was trying to use the same method to insert the Table1 in the email's body. 

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")
.
.
.

My question is:

Is there another way to copy and paste this Table1 from PowerPoint to the email's body with VBA code?

It can be as an Image/Picture from the Table or even not in the same exact format that it is in PowerPoint, because until now I am sending it as an attachment file and I believe it is easier to read when the Table is visible under the text written in the email.

Upvotes: 1

Views: 709

Answers (1)

areed1192
areed1192

Reputation: 602

Here is a basic example that will take a PowerPoint Table and copy it over to an outlook email using early binding.

Keep in mind this can be volatile at times, in other words, the information doesn't actually make it to the clipboard but this can be dealt with by pausing the application for a few seconds. Also, this will work if Outlook is ALREADY OPEN.

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

Upvotes: 1

Related Questions