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.
sean schaefbauerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
Can you supply a sample doc?
0
sean schaefbauerAuthor Commented:
0
Martin LissOlder than dirtCommented:
I'm sorry but I don't think I'm going to be able to help after all.
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

sean schaefbauerAuthor Commented:
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.
0
Martin LissOlder than dirtCommented:
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

0
sean schaefbauerAuthor Commented:
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.
0
Martin LissOlder than dirtCommented:
Does this help?

Sub ChangeInlineShapeLinks()
    Dim ilsh As InlineShape
    Dim strNewPath As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    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
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
sean schaefbauerAuthor Commented:
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

0
Martin LissOlder than dirtCommented:
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)
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.