Edit Excel Links in PPT Using VBA and Early Binding

[Baiano42]

Greeting,

I've been trying to find a way to make my daily PPT report be more automated, and the biggest problem that I am crossing is getting the Excel Link to update to the most recent file location. I recently came across a article from Excel Off the Grid that noted that I could use early binding in Excel to link to the PPT instead of linking in PPT itself. The first part of the macro is designed to always know the last place my report was saved and get the current directory for it now.

Using the code below, it runs the macro, I get the following error code:
Run-time error '-2147467259 (80004005)':
Method 'SourceFullName' of object 'LinkFormat' failed

When I look at the linked object in the PPT, the link has not been changed. What needs to be changed here to make it replace the old link with the new one?

Sub EditPowerPointLinks() 
'Set the link to the Object Library:
'Tools -> References -> Microsoft PowerPoint x.xx Object Library
 
Dim oldFilePath As String
Dim newFilePath As String
Dim sourceFileName As String
Dim pptApp As PowerPoint.Application
Dim pptPresentation As Object
Dim pptSlide As Object
Dim pptShape As Object


    Application.CutCopyMode = False
    Range("B5").Select
    Selection.Copy
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D5").Select
    Selection.Copy
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
'The file name and path of the file to update
sourceFileName = Range("E5").Value
 
'The old file path as a string (the text to be replaced)
oldFilePath = Range("C5").Value
 
'The new file path as a string (the text to replace with)
newFilePath = Range("B5").Value
 
'Set the variable to the PowerPoint Application
Set pptApp = New PowerPoint.Application
 
'Make the PowerPoint application visible
pptApp.Visible = True
 
'Set the variable to the PowerPoint Presentation
Set pptPresentation = pptApp.Presentations.Open(sourceFileName)
 
'Loop through each slide in the presentation
For Each pptSlide In pptPresentation.Slides
 
    'Loop through each shape in each slide
    For Each pptShape In pptSlide.Shapes
  
        'Find out if the shape is a linked object or a linked picture
        If pptShape.Type = msoLinkedPicture Or pptShape.Type _
        = msoLinkedOLEObject Then
 
            'Use Replace to change the oldFilePath to the newFilePath
            pptShape.LinkFormat.SourceFullName = Replace(LCase _
            (pptShape.LinkFormat.SourceFullName), LCase(oldFilePath), newFilePath)
 
        End If
    Next
Next
 
pptPresentation.UpdateLinks
 
'Release the memory
Set pptApp = Nothing
Set pptPresentation = Nothing
Set pptSlide = Nothing
Set pptShape = Nothing
 
End Sub

[Baiano42]

A quick note: to get the E5 cell to display the current PPT location, I used the following:
In Cell H1:
=SUBSTITUTE(CELL("filename"),RIGHT(CELL("filename"),LEN(CELL("filename"))-FIND("@",SUBSTITUTE(CELL("filename"),"","@",LEN(CELL("filename"))-LEN(SUBSTITUTE(CELL("filename"),"",""))),1)),"*PPT*")
Went to Formulas->Define Name->(Name the new Defined Name without spaces), set the "Refers to:"
=FILES(Sheet1'!$H$1)
In Cell H2:
=INDEX(FileNameList,1)
In Cell H3:
=LEFT(CELL("filename"),FIND("[",CELL("filename"),1)-1)
In Cell H4:
=H3&H2

[Baiano42]

Ok, after a *Lot* of trial and error, I was able to solve my own question, here is the final code I ended up with. (As I'm a complete novice at Excel VBA, there likely are ways to refine it further, but it works for me...)

'I wanted to make it run automatically every time, so I set it to run when I change the last variable in the excel portion of the report.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I6")) Is Nothing Then

    'to speed up the process of the macro

    Application.ScreenUpdating = False


    'Resets equation for Time to get either 0600 or 1800CST (In case one changes the cell, e.g. "1200 CST" for some reason
    Range("H4").Value = "=IF('RNS Team'!F2=""PM"",""1800 CST"",""0600 CST"")"
    
   'Update Report#: to current report # by counting the number of PDF's in the folder and adding 1
    Dim FolderPath As String
    Dim path As String
    Dim count As Integer
    
    FolderPath = Application.ActiveWorkbook.path
        path = FolderPath & "\*.pdf"
            Filename = Dir(path)
                Do While Filename <> ""
                count = count + 1
                Filename = Dir()
        Loop
    Range("H2").Value = count + 1
    
'Update Linked Object In PPT
Dim oldFilePath As String
Dim newFilePath As String
Dim sourceFileName As String 'This may be a source of error as I'm sourcing it from the value in cell E5
Dim pptApp As PowerPoint.Application
Dim pptPresentation As Object
Dim pptSlide As Object
Dim pptShape As Object


    'This part is to identify the sourceFileName, oldFilePath, & newFilePath (see next section)
    Application.CutCopyMode = False
    Range("B5").Select
    Selection.Copy
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D5").Select
    Selection.Copy
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    If [B5] <> [C5] Then
        Range("C5").Select
            Application.CutCopyMode = False
            Selection.Copy
        Range("F5").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Else
    End If
        'this changes the end of each cell I used the "Paste:=xlPasteValues" in to what links to PPT
        Cells.Replace What:="[Daily Report Link.xlsm]Report", Replacement:= _
        "Daily Report Link.xlsm!Report!R1C1:R8C10", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False


    ActiveWorkbook.Save
        
'The file name and path of the file to update
sourceFileName = Range("E5").Value
 
'The old file path
oldFilePath = Range("F5").Value
 
'The new file path
newFilePath = Range("B5").Value
 
'Set the variable to the PowerPoint Application
Set pptApp = New PowerPoint.Application
 
'Make the PowerPoint application visible
pptApp.Visible = True
 
'Set the variable to the PowerPoint Presentation
Set pptPresentation = pptApp.Presentations.Open(sourceFileName) 'sourcing to E5 value
 
'Loop through each slide in the presentation
For Each pptSlide In pptPresentation.Slides
 
    'Loop through each shape in each slide
    For Each pptShape In pptSlide.Shapes
  
        'Find out if the shape is a linked object or a linked picture
        If pptShape.Type = msoLinkedPicture Or pptShape.Type _
        = msoLinkedOLEObject Then
 
            'Use Replace to change the oldFilePath to the newFilePath
            pptShape.LinkFormat.SourceFullName = Replace(LCase _
            (pptShape.LinkFormat.SourceFullName), LCase(oldFilePath), newFilePath)
 
        End If
    Next
Next


'Release the memory
Set pptApp = Nothing
Set pptPresentation = Nothing
Set pptSlide = Nothing
Set pptShape = Nothing


    Application.ScreenUpdating = True


End If
End Sub

[maithriy]

How can i change links in Excel from one file to another file. Can i Get a VBA for this?

[paulked]

Baniano, sometimes a problem shared works! Glad you got it sorted

Maithriy, that question is ambiguous but seems to be off topic. I'd start a new thread if I were you

[maithriy]

Baniano, sometimes a problem shared works! Glad you got it sorted

Maithriy, that question is ambiguous but seems to be off topic. I'd start a new thread if I were you

I have to update one file on daily basis. For that now i am updating through edit links. But i want to create a Vba to get the links changed automatically by entering path of file in the same file.

[paulked]

I'd start a new thread if I were you

And say exactly what you want to do.

But i want to create a Vba to get the links changed automatically by entering path of file in the same file.

Give examples of links to change, state where files are located etc. Even better, post a workbook.

But START A NEW THREAD!