Sub MailMergeWithImages()
    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 imagePath As String
    Dim shape As shape
    Dim imgShape As shape
    Dim originalSlide As slide
    Dim newSlide As slide
    Dim imagePlaceholder As shape

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

   
    Set ppt = ActivePresentation

    If ppt.Slides.Count > 0 Then
        Set originalSlide = ppt.Slides(1) 

   
        i = 2
        Do While ws.Cells(i, 1).Value <> ""
       
            nameText = ws.Cells(i, 1).Value
            imagePath = ws.Cells(i, 2).Value
            
         
            Set newSlide = ppt.Slides.Add(ppt.Slides.Count + 1, ppLayoutText)
            
           
            For Each shape In originalSlide.Shapes
                shape.Copy
                newSlide.Shapes.Paste
            Next shape
            
          
            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
            
           
            For Each shape In newSlide.Shapes
                If shape.Name = "MyImages" Then 
                    Set imagePlaceholder = shape
                    Exit For
                End If
            Next shape
            
         
            If Dir(imagePath) <> "" Then
                
                If Not imagePlaceholder Is Nothing Then
                    Set imgShape = newSlide.Shapes.AddPicture(imagePath, _
                        MsoTriState.msoFalse, MsoTriState.msoCTrue, _
                        imagePlaceholder.Left, imagePlaceholder.Top, _
                        imagePlaceholder.Width, imagePlaceholder.Height)
                Else
                    MsgBox "Image placeholder not found.", vbExclamation, "Error"
                End If
            Else
                MsgBox "Image not found: " & imagePath, 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

   
    wb.Close False
    excelApp.Quit
    Set excelApp = Nothing
End Sub