Скопируйте собственную таблицу PowerPoint в тело электронного письма Outlook - PullRequest
Новая
       11

Скопируйте собственную таблицу PowerPoint в тело электронного письма Outlook

0 голосов
/ 19 декабря 2018

Я не могу предоставить весь код.Это из внутреннего проекта моей компании.

Я создал код 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.Я прочитал, что, возможно, я смогу сделать это, используя .HTMLBody = StrBody & RangetoHTML(rng) внутри OutMail, как описано ниже: 

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

Мой вопрос:

Есть ли другой способ скопировать и вставить эту таблицу Table1 из PowerPoint в тело письма с кодом VBA?

Это может быть изображение или картинка из таблицы или даже не в том же формате, что и в PowerPoint, потому что до сих пор я отправляю его в виде файла вложения и считаю, что его легче читать, когда таблица виднапод текстом написанным в электронном письме.

1 Ответ

0 голосов
/ 19 декабря 2018

Вот базовый пример, который возьмет таблицу 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
...