VBA Code crashes PPT Application - unclear reason - vba

Question

I have a problem with the following Code. What happens is that my PPT application crashes while running the code. It does not always happen and it happens in different parts of the code.
I tried the application.wait-method, but it did not work.
help is appreciated since I am already working on this for days -.-. Thanks in advance.
Option Explicit
Public myfilename As String
Sub filepicker()
Dim i As Variant
MsgBox ("In the following dialog please choose the current file")
Dim myfilenamepicker As FileDialog
Set myfilenamepicker = Application.FileDialog(msoFileDialogFilePicker)
myfilenamepicker.InitialFileName = "C:\Users\Michael\Desktop\Test PPT"
myfilenamepicker.Show
If myfilenamepicker.SelectedItems.Count <> 0 Then
myfilename = myfilenamepicker.SelectedItems(1)
End If
End Sub
Sub Saveas_PPT_and_PDF()
Dim PP As PowerPoint.Presentation
Dim sh As Variant
Dim company, strPOTX, strPfad, pptVorlage, newpath, newpathpdf As String
Dim Cell As Range
Dim pptApp As Object
Call filepicker
Application.ScreenUpdating = False
' set the dropdown from which the company Is Selected
Set DropDown.ws_company = Tabelle2
' the company is the value selected in the dropdown, stored in "C2"
company = DropDown.ws_company.Range("C2").Value
On Error Resume Next
Set pptApp = GetObject(, "PowerPoint.Application")
On Error Resume Next
If pptApp Is Nothing Then
Set pptApp = CreateObject("PowerPoint.Application")
End If
On Error GoTo 0
'loop through the companies in the dropdown menu
For Each Cell In DropDown.ws_company.Range(DropDown.ws_company.Cells(5, 3), _
DropDown.ws_company.Cells(Rows.Count, 3).End(xlUp)).SpecialCells(xlCellTypeVisible)
DropDown.ws_company.Range("C2") = Cell
pptVorlage = myfilename
Debug.Print (myfilename)
Set PP = pptApp.Presentations.Open(pptVorlage)
newpath = Replace(myfilename, "AXO", "" & Cell & " AXO")
PP.UpdateLinks
PP.SaveAs newpath
newpathpdf = Replace(newpath, "pptx", "pdf")
Debug.Print (newpathpdf)
PP.ExportAsFixedFormat "" & newpathpdf & "", ppFixedFormatTypePDF, ppFixedFormatIntentPrint
pptApp.Presentations(newpath).Close
Set PP = Nothing
Next
' this part below closes PPT application if there are no other presentation
' object open. If there is at least 1, it leaves it open
If IsAppRunning("PowerPoint.Application") Then
If pptApp.Windows.Count = 0 Then
pptApp.Quit
End If
End If
Set pptApp = Nothing
Set PP = Nothing
End Sub
Function IsAppRunning(ByVal sAppName) As Boolean
Dim oApp As Object
On Error Resume Next
Set oApp = GetObject(, sAppName)
If Not oApp Is Nothing Then
Set oApp = Nothing
IsAppRunning = True
End If
End Function

Answer 1

I don't see anything obviously wrong but I can give you a strategy for debugging.
You will want to test all major manipulations seperately. You will want to run each test in the debugger and have screenupdating on so you can see what happens:
test the filepicker
test GetObject/CreateObject - do you really need it? You already have PowrPoint open it seems;
test your loop with a single hardcoded value. What happens with the focus when opening a presentation?
try without UpdateLinks; try without SaveAs and try without Export (i.e. just open a presentation and close it again).
check if the presentation really closes, otherwise you might end up with lots of open presentations.
test closing the application
test reading from a dropdown box
test the IsAppRunning function. Note that it sets On Error Resume Next but does not reset it. Note it does not set IsAppRunning = False anywhere.
try relevant parts of the above in a loop with and without debugging to see what happens and see if it crashes - there could be a timing problem in the Office application, e.g. trying to manipulate a presentation while it is not yet fully loaded.
Minimising your code can help isolate the area that causes the problem. I hope this helps.