Batch re-save presentations; update older presentations to newer PowerPoint version

Problem

You have a folder full of PowerPoint files from an older version and want to open and resave each to the current PowerPoint version. For example, newer versions of PowerPoint won't open PowerPoint 95 files but you can open them in PowerPoint 97, 2000, 2002 or 2003 and save again; after that you can open them in the newer PPT versions.

Or you have files that have been edited repeatedly and saved with PowerPoint's dreaded Fast Saves enabled. They've become huge and bloated. You've turned Fast Saves off but now you need to open and resave every file to clean out the fat.

For just a few files, this is simple. But suppose you have hundreds of them? You need an automated solution.

Automation to the rescue

If you're using a version of PowerPoint that won't open your files, you'll need to find a computer with an earlier PowerPoint version that can open them and perform the conversion there.

Take note of the folder where the files are stored. You'll need to type the complete path to it.

Run this macro. It will open and resave each PPT file it finds in the folder you specify.

When done, you'll have two versions of each file you started with. The original is renamed to OriginalName.PPT.OLD and the newly saved file has the same name as the original did.

Sub BatchSave()
' Opens each PPT in the target folder and saves as PPT97-2003 format

    Dim sFolder As String
    Dim sPresentationName As String
    Dim oPresentation As Presentation

    ' Get the foldername:

    sFolder = InputBox("Folder containing PPT files to process", "Folder")

    If sFolder = "" Then
        Exit Sub
    End If

    ' Make sure the folder name has a trailing backslash
    If Right$(sFolder, 1) <> "\" Then
        sFolder = sFolder & "\"
    End If

    ' Are there PPT files there?
    If Len(Dir$(sFolder & "*.PPT")) = 0 Then
        MsgBox "Bad folder name or no PPT files in folder."
        Exit Sub
    End If

    ' Open and save the presentations
    sPresentationName = Dir$(sFolder & "*.PPT")
    While sPresentationName <> ""
        Set oPresentation = Presentations.Open(sFolder & sPresentationName, , , False)
        Call oPresentation.SaveAs(sFolder & "N_" & sPresentationName, ppSaveAsPresentation)
        oPresentation.Close
        ' New presentation is now saved as N_originalname.ppt
        ' Now let's rename them - comment out the next couple lines
        '   if you don't want to do this
        ' Original.PPT to Original.PPT.OLD
        Name sFolder & sPresentationName As sFolder & sPresentationName & ".OLD"
        ' N_Original.PPT to Original.PPT
        Name sFolder & "N_" & sPresentationName As sFolder & sPresentationName
        sPresentationName = Dir$()
    Wend

    MsgBox "DONE"

End Sub

See How do I use VBA code in PowerPoint? to learn how to use this example code.

---