Baiano42
07-28-2019, 11:51 AM
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
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