VBA Macro Issue - VBA to automate creating new PP/Excel sheets and updating the links

[noobslayer252]

Hello,

I'm having troubles with a VBA code I have written which is designed to do the below:

1. Define File Paths:
   • The macro begins by defining several string variables for file paths: originalPptPath, newPptPath, originalExcelPath, newExcelPath.
   • These variables are assigned the paths of the original and new (V2) versions of both the PowerPoint and Excel files.
2. Update PowerPoint Links:
   • The macro iterates through each slide and shape in the current PowerPoint presentation.
   • For shapes that are linked objects (like charts or OLE objects), it checks if their link source includes the path of the original Excel file (originalExcelPath).
   • If so, it replaces this path with the new Excel file path (newExcelPath) and updates the link.
   • This step is crucial for ensuring that all data links in the PowerPoint presentation point to the new version of the Excel file instead of the original one.
3. Save New PowerPoint Version:
   • After updating the links, the macro saves the current PowerPoint presentation as a new file, effectively creating the "Version 2" of the presentation.
   • This is done using the SaveAs method with the newPptPath.
4. Handle Excel File:
   • The macro then automates Excel using CreateObject("Excel.Application") to open the original Excel file.
   • It saves this Excel file as a new file (the "V2" version) using the SaveAs method with the newExcelPath.
   • Finally, it closes the Excel application.

The code is:

Sub SaveAsNewVersionAndUpdateLinks()
    ' Define the original and new file paths
    Dim originalPptPath As String, newPptPath As String
    Dim originalExcelPath As String, newExcelPath As String

    ' Updated file paths
    originalPptPath = "N:\_Initiative\Clients\2023\IAG\_Comms Design\Charlie Dox\INI-VENTORS\Audience Book Test V1.pptm"
    newPptPath = "N:\_Initiative\Clients\2023\IAG\_Comms Design\Charlie Dox\INI-VENTORS\Audience Book Test V2.pptm"
    originalExcelPath = "\\sydfpr05a\IPG\AUS-MBW\_Initiative\Clients\2023\IAG\_Comms Design\Charlie Dox\INI-VENTORS\Ini Ventors Draft Excel V1.xlsm"
    newExcelPath = "\\sydfpr05a\IPG\AUS-MBW\_Initiative\Clients\2023\IAG\_Comms Design\Charlie Dox\INI-VENTORS\Ini Ventors Draft Excel V2.xlsm"

    ' Update links in the current presentation to point to the new Excel file
    Dim slide As Object, shape As Object
    For Each slide In ActivePresentation.Slides
        For Each shape In slide.Shapes
            If shape.Type = msoLinkedOLEObject Or shape.Type = msoLinkedChart Then
                If InStr(shape.LinkFormat.SourceFullName, originalExcelPath) > 0 Then
                    shape.LinkFormat.SourceFullName = Replace(shape.LinkFormat.SourceFullName, originalExcelPath, newExcelPath)
                    shape.LinkFormat.Update
                End If
            End If
        Next shape
    Next slide

    ' Save the current PowerPoint as a new file with updated links
    ActivePresentation.SaveAs newPptPath, ppSaveAsOpenXMLPresentationMacroEnabled

    ' Close the original presentation
    ActivePresentation.Close

    ' Create and open Excel application, save the workbook as a new file, then close Excel
    Dim excelApp As Object
    Set excelApp = CreateObject("Excel.Application")
    excelApp.Workbooks.Open (originalExcelPath)
    excelApp.ActiveWorkbook.SaveAs (newExcelPath)
    excelApp.Quit

    ' Optionally, open the new PowerPoint file (V2)
    ' Application.Presentations.Open newPptPath
End Sub

Problem: When I open my V2 PP file the charts still link back to V1 excel. I have even manually checked via "Edit Links To Files" and it's telling me that its still linked to the V1 file (picture below):

Is there something wrong my code, how can I resolve this issue.