Simple VBA Script to merge or combine all the powerpoint files in a folder into a new one! Steps: Open a new presentation file and save it to the folder all the files you want to combine are in (you can move it later) Paste the code into the VBA window Run the InsertAllSlides macro and it will combine them.

Merge Multiple PPT VBA

Sub InsertAllSlides()
'  Insert all slides from all presentations in the same folder as this one
'  INTO this one; do not attempt to insert THIS file into itself, though.

    Dim vArray() As String
    Dim x As Long

    ' Change "*.PPT" to "*.PPTX" or whatever if necessary:
    EnumerateFiles ActivePresentation.Path & "\", "*.PPTX", vArray

    With ActivePresentation
        For x = 1 To UBound(vArray)
            If Len(vArray(x)) > 0 Then
                .Slides.InsertFromFile vArray(x), .Slides.Count
            End If
        Next
    End With

End Sub

Sub EnumerateFiles(ByVal sDirectory As String, _
    ByVal sFileSpec As String, _
    ByRef vArray As Variant)
    ' collect all files matching the file spec into vArray, an array of strings

    Dim sTemp As String
    ReDim vArray(1 To 1)

    sTemp = Dir$(sDirectory & sFileSpec)
    Do While Len(sTemp) > 0
        ' NOT the "mother ship" ... current presentation
        If sTemp <> ActivePresentation.Name Then
            ReDim Preserve vArray(1 To UBound(vArray) + 1)
            vArray(UBound(vArray)) = sDirectory & sTemp
        End If
        sTemp = Dir$
    Loop

End Sub

How can I keep source formatting? what do I add to this code to make it work? I tried differents things and not working :-(

Thanks for sharing! It works well!

I get error 52 on
sTemp = Dir$(sDirectory & sFileSpec)

Can anyone assist?

I get error 52 on sTemp = Dir$(sDirectory & sFileSpec)

Can anyone assist?

Seems to not work in Sharepoint folders (maybe neither on OneDrive) because of weird quirks in VBA handling those file paths.
In
`Sub EnumerateFiles(ByVal sDirectory As String, _
ByVal sFileSpec As String, _
ByRef vArray As Variant)
' collect all files matching the file spec into vArray, an array of strings

Dim sTemp As String
ReDim vArray(1 To 1)

sTemp = Dir$(sDirectory & sFileSpec)`

In sTemp = Dir$(sDirectory & sFileSpec) change sDirectory to the local file path of your presentation folder e.g. "C:\User\Yourfolder\" Then it works like a charm.

Hi! I could not make it works. I paste the code in a VBA project, tried to execute it, changed the directory like @tkehren sugested but when i ran it it did nothing. All files are in the same location as the main file.


What i am doing wrong? The main file is TESTE.pptm.

It did work now!
I had to change the variable sDirectory to the path of the folder such as sugested. If i don't do it, it loads as a sharepoint link and it breaks the script. I think it did not worked at the first try because i did not save the script (lol, i am used to VSCode and autosave). Thanks very much for the script, it really helped me.

I get error 52 on sTemp = Dir$(sDirectory & sFileSpec)
Can anyone assist?

Seems to not work in Sharepoint folders (maybe neither on OneDrive) because of weird quirks in VBA handling those file paths. In `Sub EnumerateFiles(ByVal sDirectory As String, _ ByVal sFileSpec As String, _ ByRef vArray As Variant) ' collect all files matching the file spec into vArray, an array of strings

Dim sTemp As String
ReDim vArray(1 To 1)

sTemp = Dir$(sDirectory & sFileSpec)`

In sTemp = Dir$(sDirectory & sFileSpec) change sDirectory to the local file path of your presentation folder e.g. "C:\User\Yourfolder\" Then it works like a charm.