Batch export PowerPoint files to JPG

Question

I have around 100+ PowerPoint files that have to be exported into image files. I currently export them one by one which is a super long and boring task. Any way around this. Thanks in advance.

Answer 1

Based on what Steve said in JohnK's link something like this

Make a folder on the desktop named 'Files'

Put the pptx files in it (I would start with maybe 6 as a test)

Run the macro 

Sub ForEachPresentation()

' Based on code from Steve Rindsberg www.pptfaq.com

' Run a macro of your choosing on each presentation in a folder

    Dim rayFileList() As String

    Dim FolderPath As String

    Dim FileSpec

    Dim strTemp As String

    Dim x As Long

    ' EDIT THESE to suit your situation

    ' This is a folder called Files on the Desktop

    FolderPath = Environ("USERPROFILE") & "\Desktop\Files"  ' Note: MUST end in \

    FileSpec = "*.pptx"

    ' END OF EDITS

    ' Fill the array with files that meet the spec above

    ReDim rayFileList(1 To 1) As String

    strTemp = Dir$(FolderPath & FileSpec)

    While strTemp <> ""

        rayFileList(UBound(rayFileList)) = FolderPath & strTemp

        ReDim Preserve rayFileList(1 To UBound(rayFileList) + 1) As String

        strTemp = Dir

    Wend

    ' array has one blank element at end - don't process it

    ' don't do anything if there's less than one element

    If UBound(rayFileList) > 1 Then

        For x = 1 To UBound(rayFileList) - 1

            Call exporter(rayFileList(x))

        Next x

    End If

End Sub

Sub exporter(strName)

Dim saveName As String

Dim ipos As Integer

Dim ipos2 As Integer

Dim opres As Presentation

Set opres = Presentations.Open(FileName:=strName, WithWindow:=False)

'extract file name from path

ipos2 = InStrRev(strName, ".")

ipos = InStrRev(strName, "")

saveName = Mid(strName, ipos + 1, ipos2 - ipos)

Call opres.SaveAs(Environ("USERPROFILE") & "\Desktop\Files" & saveName, ppSaveAsJPG)

opres.Close

End Sub

The jpgs should be in the same folder

Answer 2

Wow! Thank you so much. Is it possible to combine this macro that you gave me earlier with the macro you provided above?

Sub exporter()

Dim osld As Slide

Dim strFolder As String

Dim strname As String

Dim n As Long

strname = InputBox("Choose a series name", "Name", "")

'Images will be in Desktop\Pics\

strFolder = Environ("USERPROFILE") & "\Desktop\Pics" & strname & ""

On Error Resume Next

MkDir strFolder

For Each osld In ActivePresentation.Slides

n = n + 1

osld.Export strFolder & "Slide" & Format(n, "000") & ".jpg", "JPG"

Next osld

End Sub

https://answers.microsoft.com/en-us/msoffice/forum/msoffice\_powerpoint-mso\_win10-mso\_2019/exported-images-filename-format-powerpoint/e9eefb5e-6fc5-4a40-ad62-e699f1c7a531?messageId=b18d6a52-0aa7-450d-908b-4a1124969df5

Answer 3

You can write a VBA macro to do that. Here's a Stack Overflow post about a similar issue. Take a look at the answer from Steve Rindsberg: Powerpoint VBA loop through all presentations in folder.

The second listing shows how to loop though a folder full of presentations. You would just have to replace the ChangeShapeColor sub with one that exports the slides as images.