Search & Replace to change OLE link paths

Problem

Suppose you've got a lot of links in a PPT file or files and all the links point to a network share.

Then somebody comes along and installs a new server with a new name. Maybe they copy all of your files to the new server, but all of your links break because they point to \\OldServer\YourPath\ but the files are now on \\NewServer\YourPath\

Solution

This little macro will look for all of the OLE links in your presentation and change \\OldServer\ to \\NewServer\ (and if the folder names changed, it'll fix that too).

You'll need to edit the paths it searches for and replaces where indicated below.

Please run this only on a COPY of your important presentation files. Note that you won't see any changes until you save the presentation then re-open it and allow PowerPoint to update the links. We could force it to update immediately but that'd slow it down considerably.

Sub ChangeOLELinks()
' Note: this will only work in PPT 2000 and later

    Dim oSld As Slide
    Dim oSh As Shape
    Dim sOldPath As String
    Dim sNewPath As String

    ' EDIT THIS TO REFLECT THE PATHS YOU WANT TO CHANGE
    ' Include just the portion of the path you want to change
    ' For example, to change links to reflect that files have moved from
    ' \\boss\p-drive\temp\*.* to
    ' \\boss\Q-drive\temp\*.*
    sOldPath = "\\boss\p-drive\"
    sNewPath = "\\boss\q-drive\"

    On Error GoTo ErrorHandler

    For Each oSld In ActivePresentation.Slides
        For Each oSh In oSld.Shapes
            ' Change only linked OLE objects
            If oSh.Type = msoLinkedOLEObject Then
                On Error Resume Next
                ' Verify that file exists
                If Len(Dir$(Replace(oSh.LinkFormat.SourceFullName, sOldPath, sNewPath))) > 0 Then
                     oSh.LinkFormat.SourceFullName = Replace(oSh.LinkFormat.SourceFullName, sOldPath, sNewPath)
                Else
                      MsgBox("File is missing; cannot relink to a file that isn't present")
                End If
                On Error GoTo ErrorHandler
             End If
        Next    ' shape
    Next    ' slide

    MsgBox("Done!")

NormalExit:
    Exit Sub
ErrorHandler:
    MsgBox("Error " & err.number & vbcrlf & err.description)
    Resume NormalExit

End Sub

See How do I use VBA code in PowerPoint? to learn how to use this example code.

---