Sub PPTFilesToPDF()
Dim objPresentaion As Presentation
Dim objSlide As Slide
Dim objTextBox As Shape
Set objPresentaion = ActivePresentation
Set objSlide = objPresentaion.Slides.Item(1)
Set objTextBox = objSlide.Shapes.Item(1)
Dim sFolder As String
Dim sFile As String
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim bNewInstance As Boolean
sFolder = objTextBox.TextFrame.TextRange.Text 'change the path accordingly'
If Right(sFolder, 1) <> "\" Then
sFolder = sFolder & "\"
End If
sFile = Dir(sFolder & "*.pptx", vbNormal)
If Len(sFile) = 0 Then
MsgBox "No files found.", vbExclamation
Exit Sub
End If
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
If ppApp Is Nothing Then
Set ppApp = CreateObject("PowerPoint.Application")
bNewInstance = True
End If
On Error GoTo 0
Do While Len(sFile) > 0
Set ppPres = ppApp.Presentations.Open(sFolder & sFile)
sFile = Left(sFile, Len(sFile) - 5)
ppPres.ExportAsFixedFormat sFolder & sFile & ".pdf", ppFixedFormatTypePDF, ppFixedFormatIntentPrint
ppPres.Close
sFile = Dir
Loop
If bNewInstance Then _
ppApp.Quit
Set ppApp = Nothing
Set ppPres = Nothing
MsgBox "Completed...", vbInformation
End Sub
