Skip to content

Instantly share code, notes, and snippets.

@bhandarisaurav
Created September 6, 2018 07:08
Show Gist options
  • Save bhandarisaurav/f0da2bcc7f64919e672ed1ea99f5c47f to your computer and use it in GitHub Desktop.
Save bhandarisaurav/f0da2bcc7f64919e672ed1ea99f5c47f to your computer and use it in GitHub Desktop.
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.
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
@marchorse
Copy link

Thanks for sharing! It works well!

@InonCohen
Copy link

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

Can anyone assist?

@tkehren
Copy link

tkehren commented May 11, 2023

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.

@gfreire57
Copy link

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.
image
image
What i am doing wrong? The main file is TESTE.pptm.

@gfreire57
Copy link

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.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment