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

Hello everyone, I'm new to the community but I'm working on joining two PowerPoint presentations but for certain slides using a text file (batch guide), but I haven't been able to get it to work. I'm sharing my code with you in case anyone has any suggestions to make it work, I would really appreciate it. A hug to everyone.

..................
Sub InsertAllSlidesFromBatch()
Dim fso As Object
Dim fileStream As Object
Dim line As String
Dim parts As Variant
Dim filePath As String
Dim slideNumber As Integer
Dim pptMain As Presentation
Dim fd As FileDialog
Dim savePath As String

On Error GoTo ErrorHandler


Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .Title = "Selecciona el archivo batch"
    .Filters.Add "Archivos de texto", "*.txt", 1
    .AllowMultiSelect = False
    If .Show = -1 Then
        batchFilePath = .SelectedItems(1)
    Else
        MsgBox "No se seleccionó ningún archivo. Abortando.", vbExclamation
        Exit Sub
    End If
End With


Set pptMain = Presentations.Add


Set fso = CreateObject("Scripting.FileSystemObject")
Set fileStream = fso.OpenTextFile(batchFilePath, 1)

Do While Not fileStream.AtEndOfStream
    line = fileStream.ReadLine
    If Trim(line) <> "" Then
        parts = Split(line, ",")
        If UBound(parts) = 1 Then
            slideNumber = CInt(Trim(parts(0)))
            filePath = Trim(parts(1))
            

            ProcessSlideFromBatch filePath, slideNumber, pptMain
        Else
            MsgBox "Formato de línea incorrecto: " & line, vbExclamation
        End If
    End If
Loop


fileStream.Close


Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
    .Title = "Guardar presentación combinada"
    .Filters.Add "Presentaciones de PowerPoint", "*.pptx", 1
    .InitialFileName = "Presentación_Combinada_" & Format(Now, "yyyymmdd_hhnnss") & ".pptx"
    If .Show = -1 Then
        savePath = .SelectedItems(1)
        pptMain.SaveAs savePath
        MsgBox "Presentación combinada guardada en: " & savePath, vbInformation
    Else
        MsgBox "No se seleccionó una ruta para guardar. Presentación no guardada.", vbExclamation
    End If
End With

Cleanup:
' Liberar objetos
On Error Resume Next
If Not fileStream Is Nothing Then fileStream.Close
Set fso = Nothing
Set fileStream = Nothing
Set fd = Nothing
If Not pptMain Is Nothing Then pptMain.Close
Exit Sub

ErrorHandler:
MsgBox "Se produjo un error: " & Err.Description, vbCritical
Resume Cleanup
End Sub

Sub ProcessSlideFromBatch(filePath As String, slideNumber As Integer, pptMain As Presentation)
Dim pptSource As Presentation

On Error GoTo SlideError


If Dir(filePath) = "" Then
    MsgBox "Archivo no encontrado: " & filePath, vbExclamation
    Exit Sub
End If


Set pptSource = Presentations.Open(filePath, WithWindow:=msoFalse)


If slideNumber > 0 And slideNumber <= pptSource.Slides.Count Then

    pptMain.Slides.InsertFromFile filePath, pptMain.Slides.Count, slideNumber, slideNumber
Else
    MsgBox "Número de diapositiva inválido: " & slideNumber & " en " & filePath, vbExclamation
End If


pptSource.Close
Set pptSource = Nothing
Exit Sub

SlideError:
MsgBox "Error al procesar la diapositiva del archivo: " & filePath & vbCrLf & Err.Description, vbCritical
If Not pptSource Is Nothing Then pptSource.Close
Set pptSource = Nothing
End Sub

...........................

How can I keep source formatting? what do I add to this code to make it work?