Automate creating new PP/Excel sheets and updating the links

Question

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

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.

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.

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.

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.

The new PP V2 charts to be linked to the new V2 excel sheet. **

Answer 1

working VBA Code for you below and explanation for what its doing:

• File Paths: The code starts by defining the original file paths for the PowerPoint and Excel files (originalPptPath and originalExcelPath) as well as the new file paths (newPptPath and newExcelPath). These paths indicate where the original and new files are located.

  Excel Application: It then creates an instance of Microsoft Excel (excelApp) using the CreateObject method. This is used to interact with Excel programmatically.

  Open and Save Excel Workbook: The Excel workbook located at originalExcelPath is opened using the excelApp.Workbooks.Open method. The workbook is then saved with a new name (newExcelPath) using the excelApp.ActiveWorkbook.SaveAs method. This step effectively creates a new version of the Excel file.

  Disable Alerts: To avoid getting warning boxes during the process, the Application.DisplayAlerts property is set to False.

  Update Links in PowerPoint: The code iterates through each slide in the active PowerPoint presentation. For each shape on a slide, it checks if the shape is either a linked OLE object or a chart. If it is, it attempts to update the link to the new Excel file (newExcelPath). This is done by modifying the shape.LinkFormat.SourceFullName property and then calling shape.LinkFormat.Update to ensure the link is updated.

  Re-enable Alerts: After updating the links, the Application.DisplayAlerts property is set back to True to re-enable warning boxes.

  Save PowerPoint as New Version: Finally, the active PowerPoint presentation is saved with a new name (newPptPath) using the ActivePresentation.SaveAs method. It specifies that the new PowerPoint file should be saved as a macro-enabled presentation with the .pptm file extension.

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"

    ' 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

    ' Disable alerts to avoid warning boxes
    Application.DisplayAlerts = False

    ' 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 = msoChart Then
                ' Use error handling for charts as they might not be linked
                On Error Resume Next
                Dim isLinked As Boolean
                isLinked = (InStr(shape.LinkFormat.SourceFullName, originalExcelPath) > 0)
                If isLinked Then
                    shape.LinkFormat.SourceFullName = Replace(shape.LinkFormat.SourceFullName, originalExcelPath, newExcelPath)
                    shape.LinkFormat.Update
                End If
                On Error GoTo 0
            End If
        Next shape
    Next slide

    ' Re-enable alerts after updating links
    Application.DisplayAlerts = True

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

Answer 2

Unless I've misunderstood, you're doing the link updates BEFORE creating the new Excel file.

If you change the links in PPT to point to a different Excel file (one that doesn't yet exist), PPT won't throw any errors, it'll just ignore you. The links won't change.

You need to create your new Excel file first, THEN change the links in PPT to point to it.

BTW, to @taller's points, it's simpler/better to standardize string casing ahead of time but if that's not possible, you can UCASE or LCASE the strings on both sides of the equation before doing any compares. Or if it's more useful, both Instr and Replace have the option to use vbTextCompare (ie, case insensitive) rather than the default vbBinaryCompare (which IS case sensitive):

If InStr(1, "NOW is the time", "now", vbTextCompare) > 0 Then
' etc

This requires you to supply all of the optional parms.