Change OLE Links with VBA

[Matthew Darling]

I have the following issue with Publisher 2003. I have moved linked files to
a different directory and need to change the links. The Edit->Links option
isn't working for several reasons: the full link is not shown in the links
window, when I click "Change Source" the only part of the link in the new
location box is the cell range used in the Excel file, and I have some 40
links to change.

While searching, I found the following help with a macro. Unfortunately the
macro is for PowerPoint. Can someone help me modify this macro to work with
Publisher?

I found the following information at
http://www.rdpslides.com/pptfaq/FAQ00759.htm

Scenario: I copied all of your files to another server, but all of your
links break because they point to \\OldServer\YourPath\ but the files are now
on \\NewServer\YourPath\

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).

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
oSh.LinkFormat.SourceFullName =
Replace(oSh.LinkFormat.SourceFullName, sOldPath, sNewPath)
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