asked on

VBA to Change Source of Embedded Excel Object?

First, I'm using MS Office 2010 (both Word & Excel)

I have excel embedded objects in a word document and I'm trying to find a way to write some VBA to update the source links to all embedded objects. Currently if the file moves the link breaks and I need coworkers to be able to create copies of the templates and link them together. I've scoured google but nothing I'm coming across works. Presently I have to right click the OLE Object, select "Macro-enabled worksheet object", select links, and then change the source one by one. With over a dozen objects this is extremely cumbersome. Any help would be great. Please let me know if you need additional information or sample docs.

Martin Liss

Can you supply a sample doc?

sean schaefbauer

ASKER

Here you go
TestDoc.docm
SampleExcel.xlsx

Martin Liss

I'm sorry but I don't think I'm going to be able to help after all.

sean schaefbauer

ASKER

Martin,

Thanks for taking a look. It seems like it should be easy, but I'm having a hard time nailing down how to reference the object in VBA. I have a few codes in the sample Word doc that I've tried, but just cant quite get there.

Martin Liss

Let's give it another shot. Try this:

Sub ChangeInlineShapeLinks()
    Dim ilsh As InlineShape
    Dim strNewPath As String
    
    strNewPath = "S:\Business Services\Internal\COMMERCIAL LOANS\JPND - Prairie Field Services\New Request - August 2018\Analysis ToolSet for CP - JPND.xlsm"
    
    For Each ilsh In ActiveDocument.InlineShapes
        If ilsh.Type = 2 Then
            ilsh.LinkFormat.SourceFullName = strNewPath
            ilsh.LinkFormat.Update
        End If
    Next ilsh
End Sub

Open in new window

sean schaefbauer

ASKER

Martin, I think you are on to something here. It works great for the first shape, however it does seem a bit buggy. It looped for a fair amount of time and since the linked excel document has external links the pop up asking if I wanted to update came at rapid fire. It also seems to create a second instance of the shape below the first whilst it loops, but that instance appears and disappears as it goes through the loop. Perhaps some code counting shapes to limit the number of loops? One would think it would still catch the second shape though considering the amount of loops.

ASKER CERTIFIED SOLUTION

Martin Liss

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

sean schaefbauer

ASKER

Thanks Martin, that got me to where I needed to go! I did make a few tweaks to help and try to mitigate the number of loops as well as provide a more dynamic way to change the link source. Final code is here:

Sub ChangeInlineShapeLinks()
    Dim ilsh As InlineShape
    Dim lShapeCnt As Long
    Dim wrdActDoc As Document
    Dim dlgSelectFile As FileDialog  'FileDialog object
    Dim selectedFile As Variant    'must be Variant to contain filepath of selected item
    Dim newFile As Variant

        
    Set wrdActDoc = ActiveDocument
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    
    'create FileDialog object as File Picker dialog box
    Set dlgSelectFile = Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
    
     
    
    With dlgSelectFile
    'use Show method to display File Picker dialog box and return user's action
        If .Show = -1 Then
    
            'step through each string in the FileDialogSelectedItems collection
            For Each selectedFile In .SelectedItems
                newFile = selectedFile    'gets new filepath
            Next selectedFile
        Else   'user clicked cancel
            Exit Sub
        End If
    End With
    Set dlgSelectFile = Nothing
    
    For lShapeCnt = 1 To wrdActDoc.InlineShapes.Count 'wrdActDoc.InlineShapes.Count
        If wrdActDoc.InlineShapes(lShapeCnt).Type = 2 Then
            wrdActDoc.InlineShapes(lShapeCnt).LinkFormat.SourceFullName = newFile
            wrdActDoc.InlineShapes(lShapeCnt).LockAspectRatio = True
            If wrdActDoc.InlineShapes(lShapeCnt).Width > 545.76 Then
                wrdActDoc.InlineShapes(lShapeCnt).Width = 545.76
            End If
           
            wrdActDoc.InlineShapes(lShapeCnt).LinkFormat.Update
        End If
    Next lShapeCnt
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

Open in new window

Martin Liss

You’re welcome and I’m glad I was able to help.

If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
Experts Exchange Most Valuable Expert (MVE) 2015, 2017
Experts Exchange Top Expert Visual Basic Classic 2012 to 2017
Experts Exchange Top Expert VBA (current)