Powerpoint链接对象的新驱动器映射-VBA解决方案

时间:2019-06-17 08:40:36

标签: excel vba powerpoint powerpoint-vba

由于IT已将服务器迁移到新路径并关闭了旧路径,因此不再识别Powerpoint中的所有链接对象(链接到excel)。

我尝试使用(https://exceloffthegrid.com/edit-links-in-powerpoint-using-vba/)中的下面的宏,但是由于旧服务器不再运行,因此当宏尝试打开旧文件路径时,它会出错

有替代解决方案吗?


Sub EditPowerPointLinks()

Dim oldFilePath As String
Dim newFilePath As String
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape

'The old file path as a string (the text to be replaced)
oldFilePath = "String of\File Path\To Be Replaced\Excel File.xlsx"

'The new file path as a string (the text to replace with)
newFilePath = "String of\New File Path\Excel File 2.xlsx"

'Set the variable to the PowerPoint Presentation
Set pptPresentation = ActivePresentation

'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

'Update the links
pptPresentation.UpdateLinks


End Sub

1 个答案:

答案 0 :(得分:1)

您的代码还可以,我也对其进行了测试。

新链接的设置由应用程序处理:

  • 如果您为链接的图片(SourceFullName)设置了新的Shape.Type = msoLinkedPicture
    该应用程序接受任何内容作为链接,并且代码不会引发错误。
  • 如果您尝试为链接的OLE对象(SourceFullName)设置新的Shape.Type = msoLinkedOLEObject,则应用程序会立即进行测试,如果新文件确实存在。
    如果链接的OLE对象不存在,则会出现错误。

结果:您必须确保新路径指向现有文件(并且需要适当的访问权限)。