Sub MailMergeWithTwoImages()
    Dim ppt As Presentation
    Dim slide As slide
    Dim excelApp As Object
    Dim wb As Object
    Dim ws As Object
    Dim i As Integer
    Dim nameText As String
    Dim imagePath1 As String
    Dim imagePath2 As String
    Dim shape As shape
    Dim imgShape1 As shape
    Dim imgShape2 As shape
    Dim originalSlide As slide
    Dim newSlide As slide
    Dim imagePlaceholder1 As shape
    Dim imagePlaceholder2 As shape

    ' Initialize Excel Application and Workbook
    Set excelApp = CreateObject("Excel.Application")
    Set wb = excelApp.Workbooks.Open("D:\AUTOMATION\ExcelFile.xlsx")
    Set ws = wb.Sheets(1)

    ' Get the active PowerPoint presentation
    Set ppt = ActivePresentation

    ' Ensure there's at least one slide in the presentation
    If ppt.Slides.Count > 0 Then
        Set originalSlide = ppt.Slides(1)

        i = 2
        Do While ws.Cells(i, 1).Value <> ""

            ' Get the name and image paths from the Excel sheet
            nameText = ws.Cells(i, 1).Value
            imagePath1 = ws.Cells(i, 2).Value
            imagePath2 = ws.Cells(i, 3).Value ' Assuming column C holds the second image path

            ' Add a new slide and copy shapes from the original slide
            Set newSlide = ppt.Slides.Add(ppt.Slides.Count + 1, ppLayoutText)
            
            ' Copy all shapes from original slide
            For Each shape In originalSlide.Shapes
                shape.Copy
                newSlide.Shapes.Paste
            Next shape

            ' Replace text placeholder (assuming title placeholder contains "[Title]")
            For Each shape In newSlide.Shapes
                If shape.HasTextFrame Then
                    If shape.TextFrame.TextRange.Text Like "*[Title]*" Then
                        shape.TextFrame.TextRange.Text = Replace(shape.TextFrame.TextRange.Text, "[Title]", nameText)
                    End If
                End If
            Next shape

            ' Find placeholders for two images
            For Each shape In newSlide.Shapes
                If shape.Name = "MyImage1" Then
                    Set imagePlaceholder1 = shape
                ElseIf shape.Name = "MyImage2" Then
                    Set imagePlaceholder2 = shape
                End If
            Next shape

            ' Insert first image
            If Dir(imagePath1) <> "" Then
                If Not imagePlaceholder1 Is Nothing Then
                    Set imgShape1 = newSlide.Shapes.AddPicture(imagePath1, _
                        MsoTriState.msoFalse, MsoTriState.msoCTrue, _
                        imagePlaceholder1.Left, imagePlaceholder1.Top, _
                        imagePlaceholder1.Width, imagePlaceholder1.Height)
                Else
                    MsgBox "First image placeholder not found.", vbExclamation, "Error"
                End If
            Else
                MsgBox "First image not found: " & imagePath1, vbExclamation, "Error"
            End If

            ' Insert second image
            If Dir(imagePath2) <> "" Then
                If Not imagePlaceholder2 Is Nothing Then
                    Set imgShape2 = newSlide.Shapes.AddPicture(imagePath2, _
                        MsoTriState.msoFalse, MsoTriState.msoCTrue, _
                        imagePlaceholder2.Left, imagePlaceholder2.Top, _
                        imagePlaceholder2.Width, imagePlaceholder2.Height)
                Else
                    MsgBox "Second image placeholder not found.", vbExclamation, "Error"
                End If
            Else
                MsgBox "Second image not found: " & imagePath2, vbExclamation, "Error"
            End If

            i = i + 1
        Loop
    Else
        MsgBox "No slide to copy from. Please ensure the presentation has at least one slide.", vbCritical, "Error"
    End If

    ' Clean up
    wb.Close False
    excelApp.Quit
    Set excelApp = Nothing
End Sub