Sorry if title is confusing. I'm trying to execute a multi-app sub that will ultimately e-mail a PDF attachment. The process first starts by extracting information from a CSV, which I've done, then it uses that information to populate a pre-existing slide in PowerPoint, which is also done. The next step is what I can't figure out. There is the ability to create Handouts via PowerPoint, but all I know is how to setup the dialog, and not how to complete the process.
PowerPointApp.CommandBars.ExecuteMso ("CreateHandoutsInWord") will open the dialog, but that's it. I've successfully used SendKeys to execute the rest, but then there is always a failure at the handoff to Word. Putting Waits in the code doesn't help. I'm working on an alternative method now, but was curious if anyone knew how to finish this process.
Sub CreateHandoutsForWord()
Dim mailSht As Worksheet
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim sl As Object
Dim myShape As Object
Dim impStr As String
Dim implStr() As String
Dim wordPath As String
Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Dim wordApp As New Word.Application
Dim wordDoc As Word.Document
Set mailSht = Worksheets("Mailer")
impStr = OpenCSV
implStr() = Split(impStr, " ")
Set fo = fso.GetFolder(mailSht.Range("E5").Value)
Set f = fo.Files("Mailer.pptx")
On Error Resume Next
Set PowerPointApp = GetObject(Class:="PowerPoint.Application")
Err.Clear
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(Class:="PowerPoint.Application")
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
Application.ScreenUpdating = False
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Open(f.Path)
Set sl = myPresentation.Slides(1)
sl.Shapes.Range(Array(2, 1)).Item(1).TextFrame.TextRange.Text = "Scott Corwin"
sl.Shapes.Range(Array(3, 1)).Item(1).TextFrame.TextRange.Text = "Guest Speaker"
PowerPointApp.CommandBars.ExecuteMso ("CreateHandoutsInWord")
Application.Wait Now + 0.00003
PowerPointApp.Activate
SendKeys "{DOWN}", True
Application.Wait Now + 0.00001
PowerPointApp.Activate
SendKeys "{DOWN}", True
Application.Wait Now + 0.00001
PowerPointApp.Activate
SendKeys "~", True
Application.Wait Now + 0.0003
PowerPointApp.Activate
myPresentation.Close
PowerPointApp.Quit
Application.Wait Now + 0.0006
Set wordApp = GetObject(Class:="Word.Application")
It just ends in a stalled app at this point by giving me a repeated error saying application is not available. Once I figure this out I already have the working code that will create the PDF and e-mail it via Outlook.
