I'm sending slides to email and I want a shape from slide 1 added between each slide [Archive]

JohnDurbin

03-06-2023, 08:04 AM

I'm using this code to send selected slides into an email message:

Sub Email_SLIDE_RANGE_Image_and_Notes2()

Dim OlApp As Object, OlMail As Object, olMailItem As Variant, WordDoc As Word.document, sld As Slide
On Error Resume Next
Set OlApp = CreateObject("Outlook.Application")
Set OlMail = OlApp.CreateItem(olMailItem)
OlMail.htmlbody = "<html> " '&
OlMail.To = ""
OlMail.Subject = "..."
OlMail.display
For Each sld In ActiveWindow.Selection.SlideRange
sld.Copy
Set WordDoc = OlMail.getinspector.wordeditor
WordDoc.Application.Selection.Paste
'add a couple characters after each slide to move the notepage text to beneath the slide image
ActivePresentation.Slides(1).NotesPage.Shapes.Placeholders(2).TextFrame.Tex tRange.Copy
WordDoc.Application.Selection.Paste
ActivePresentation.Slides(sld.SlideIndex).NotesPage.Shapes(2).TextFrame.Tex tRange.Copy
WordDoc.Application.Selection.Paste
'add a think line shape which is on the presentation's very first slide.
ActivePresentation.Slides(1).Shapes("THICKLINE").Copy
WordDoc.Application.Selection.Paste
Next sld
Set OlApp = Nothing
Set OlMail = Nothing
Set WordDoc = Nothing
End Sub

The code works great except for the adding of the THICKLINE shape from slide 1 into the email message after each slide.
It actually adds the THICKLINE BUT after the code is finished, if there are multiple slides only the last slide has the THICKLINE under it. The other THICKLINES disappear from between the other slides.
Any suggestions?...JD

Grade4.2

03-15-2023, 02:31 AM

You could try to create an inline image from the "THICKLINE" shape and insert it as an HTML element in the email message?

Sub Email_SLIDE_RANGE_Image_and_Notes2() Dim OlApp As Object, OlMail As Object, olMailItem As Variant, WordDoc As Word.Document, sld As Slide
Dim TempFilePath As String, TempFileName As String, ThickLineImagePath As String

On Error Resume Next
Set OlApp = CreateObject("Outlook.Application")
Set OlMail = OlApp.CreateItem(olMailItem)
OlMail.htmlbody = "<html> "
OlMail.To = ""
OlMail.Subject = "..."
OlMail.display

' Save the THICKLINE shape as an image
TempFilePath = Environ$("temp") & "\"
TempFileName = "ThickLineImg.png"
ThickLineImagePath = TempFilePath & TempFileName
ActivePresentation.Slides(1).Shapes("THICKLINE").Export ThickLineImagePath, ppShapeFormatPNG

For Each sld In ActiveWindow.Selection.SlideRange
sld.Copy
Set WordDoc = OlMail.GetInspector.WordEditor
WordDoc.Application.Selection.Paste

' Add a couple characters after each slide to move the notepage text to beneath the slide image
ActivePresentation.Slides(1).NotesPage.Shapes.Placeholders(2).TextFrame.Tex tRange.Copy
WordDoc.Application.Selection.Paste
ActivePresentation.Slides(sld.SlideIndex).NotesPage.Shapes(2).TextFrame.Tex tRange.Copy
WordDoc.Application.Selection.Paste

' Add the THICKLINE shape from the image saved earlier
OlMail.HTMLBody = OlMail.HTMLBody & "<img src='cid:" & TempFileName & "'> "
Next sld

' Attach the THICKLINE image to the email
With OlMail.Attachments.Add(ThickLineImagePath)
.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x3712001F", TempFileName
End With

Set OlApp = Nothing
Set OlMail = Nothing
Set WordDoc = Nothing
End Sub