Excel VBA to update OLE Linked files in PPT

Seth Brundle

I have a macro which is meant to update any OLE links within PPT from Excel (both 2000). The spreadsheet opens up a directory, looks for any ppt or pps files and then opens them.
It searches for linked objects and if there are eny it then scans through a column (containing current paths) in the spreadsheet to see if it is there and if so it then replaces with the corresponding value in column D.
Needless to say it doesn't work.
Any ideas?
(I have this working for Excel perfectly - its just poxy PPT that won't cooperate!)
My code is based on what appears to be the only way to do this - http://www.rdpslides.com/pptfaq/FAQ00759.htm

Sub replaceExternalLinks(lookinPath)
    Dim openedWorkBook As Workbook
    Dim ws As Worksheet
    Dim Cell As Object
    Dim sheet_cell, rng As Range
    Dim thisWB As String
    Dim linkArray, vArrayItem, protectedSheetArray As Variant
    Dim newValue, newFormula As Variant
    Dim strFolderName, strFileName As String
    Dim macroWorkbook, old_Folder, new_Folder As String
    Dim totalDriveRows As Long
    Dim loopRows As Long
    Dim countMatchingLinks As Integer
    Dim currentlyOpenWorkBooks As Integer
    Dim oPPTApp As PowerPoint.Application
    Dim oPPTPres As PowerPoint.Presentation
    Dim oSld As Slide
    Dim oSh As Shape
    'Dim sPresentationFile As String
    ''''''''''''''''''''''''
    'On Error Resume Next
    
    Set oPPTApp = New PowerPoint.Application
    oPPTApp.Visible = True
    
    macroWorkbook = ActiveWorkbook.Name
    Application.ScreenUpdating = False
    totalDriveRows = ActiveWorkbook.Sheets("Mapping Data").UsedRange.Rows.Count
    
    '''''''''''''''''
    'open the PPT/PPS
    With Application.FileSearch
        .NewSearch
        .LookIn = "C:\someFolder"
        .SearchSubFolders = False
        .Filename = ".ppt;.pps"
        If .Execute > 0 Then
            Dim vaFileName As Variant
            For Each vaFileName In .FoundFiles
            
                If vaFileName <> lookinPath & "\" & macroWorkbook Then
                    Application.DisplayAlerts = False
                    Application.EnableEvents = False
                    Application.AskToUpdateLinks = False
                    
                    Set oPPTPres = oPPTApp.Presentations.Open(vaFileName)
                    oPPTApp.WindowState = ppWindowMinimized
                        Dim sOldPath As String
                        Dim sNewPath As String
                        For Each oSld In [COLOR=Red]oPPTPres.Application.ActivePresentation.Slides 'oPPTPres.Slides 
                            For Each oSh In oPPTPres.Application.ActivePresentation.Slides.Shapes[/COLOR]
                                ' Change only linked OLE objects
                                If oSh.Type = msoLinkedOLEObject Then
                                    For loopRows = 4 To totalDriveRows 'start looking @ row 4
                                        Workbooks(macroWorkbook).Activate
                                        ActiveWorkbook.Worksheets("Mapping Data").Activate
                                        If ActiveWorkbook.Worksheets("Mapping Data").Range("A" & loopRows).Value <> "" And ActiveWorkbook.Worksheets("Mapping Data").Range("D" & loopRows).Value <> "" And ActiveWorkbook.Worksheets("Mapping Data").Range("A" & loopRows).Value <> "h" Then
                                            sOldPath = ActiveWorkbook.Sheets("Mapping Data").Range("A" & loopRows).Value
                                            sNewPath = ActiveWorkbook.Sheets("Mapping Data").Range("D" & loopRows).Value
                                            On Error Resume Next
                                            If InStr(oSh.LinkFormat.SourceFullName, sOldPath, vbTextCompare) Then Exit Sub
                                            [COLOR=Green]If Len(Dir$(Replace(oSh.LinkFormat.SourceFullName, sOldPath, sNewPath))) > 0 Then[/COLOR]
                                                linkArray = linkArray & "1" & vaFileName & "^," '  ActivePresentation.Path
                                                linkArray = linkArray & "2" & sOldPath & "^,"
                                                [COLOR=Green]oSh.LinkFormat.SourceFullName = Replace(oSh.LinkFormat.SourceFullName, sOldPath, sNewPath)[/COLOR]
                                                linkArray = linkArray & "3" & sNewPath & "^,"
                                                oPPTPres.Save
                                            End If
                                        End If
                                    Next ' looprows
                                End If
                            Next    ' shape
                        Next    ' slide

                oPPTPres.Save
                oPPTPres.Close
                oPPTApp.Quit
                Set oPPTPres = Nothing

                Application.EnableEvents = True
                Application.DisplayAlerts = True
                End If
            Next vaFileName
        End If
    End With
    Application.ScreenUpdating = True
    Set oPPTApp = Nothing
    
    Workbooks(macroWorkbook).Worksheets("Links Log").Activate
    
    Dim linkPart As Variant
    Dim i, j As Integer
    i = 0
    If Right(linkArray, 2) = "^," Then linkArray = Left(linkArray, Len(linkArray) - 2)
    For Each linkPart In Split(linkArray, "^,")
        ActiveCell.Value = linkPart
        i = i + 1
        If i = 3 Then
            i = 0
            ActiveCell.Offset(1, -2).Select
        Else
            ActiveCell.Offset(0, 1).Select
        End If
        ActiveCell = Selection
    Next linkPart
    Workbooks(macroWorkbook).Save
        
    Application.ScreenUpdating = True
End Sub

The bit in red is currently giving an error - the shapes part is giving "method or data member not found".
The bit in green is the bit that should perform the update!
Seemingly also, PPT will gladly look as if it will accept a new link, but if the link is not a valid path then it will eventually reject it and (possibly) resort back to the original link.

Ginger

Are you sure are referencing the PPT2000 rather than PPT2002/2003 object models. Reason I asked is that I had problems with OL2000 and OL2002/2003 object models in a similar vein.

Also sure that all the versions of the PPT files are similar or does this failover on all files?

Seth Brundle

I am referencing Excel, Powerpoint & Office 9.0 libs (amongst others).
it seems to fail over all files
I'll try it on a machine running 03 and see.

Seth Brundle

I got it running on XL/PPT 03 so that it updates the links.
However, it still required the users to click an update button on a dialog box as soon as they open the PPT file. There may be an option to stop this which I will look for.
Cheers

Seth Brundle

Im still having one problem with this and it revolves around two if
statements that are not working corrrectly:-

'oSh = shape
'sOldPath is a string representing the old path
'sNewPath is a string representing a new path

If InStr(oSh.LinkFormat.SourceFullName, sOldPath, vbTextCompare) Then
        If Len(Dir$(Replace(oSh.LinkFormat.SourceFullName, sOldPath, sNewPath))) > 0 Then
                do something #1
        Else
                do something else #1
        End IF
Else
        do something else #2
End if

However for some reason the two if statements are always true no matter
what sOldpath & sNewPath are. Trying to Cstr(oSh.LinkFormat.SourceFullName) for the instr() doesn't make any difference.
Why does it always return true for these two If statements???

Ginger

Do your replace outside the dir function...

Sounds funny I know but I had problems with that many nested functions, i dont the compiler handles them correctly

Seth Brundle

tried it - no joy

Ginger

Can you print out the value of replace and do a dir$ on that in the immediate window?

TempestSabre

Are the OLE links correct? I found OLE to be so unreliable that I avoid using it. Especially between different versions of Office and the respective object models.

Seth Brundle

Whats happeingin is the client is moving servers and currently most of the OLE links are correct (loads pointing to the C: and A: drives!).
I managed to get it running now - it just logs every attempted change whether succesful or not!

TempestSabre

Did you find out why it fails. The problem I had with OLE in Excel is that sometimes links worked and sometime they didn't. Seemed to be random. When looking for infomation from Microsoft, the solution seems to be, don't use OLE.

Seth Brundle

The instr should have had a 1 at the start as I was using vbTextCompare and its surrounding if statement should have been checking against a numeric rather than boolean value.
I haven't found out the main cause for it not working as I want (esp. given that it works fine when checking spreadsheets external linked files. I think it is becuse when updating PPT links, it all appears to be hunky dory, confirms the change to my app and then PPT eventually says feck that and doesn't update the link. So Im left with a log showing that each of the possible 900 old links have been replaced within each file that contains an external link.
I might just remove the log and leave it at that!