我们在 Word 中有一些报告模板文档，它们链接到模板 excel 文档，其中包含从 Excel 到 Word 的各种 OLE 链接对象。
由于 OLE 使用绝对路径与相对路径，因此将两个文档复制粘贴到另一个位置（甚至移动它们）会破坏 OLE 链接。
那么，促进将文档移动到另一个位置并移动 Word 模板并能够将其链接到新位置的另一个 Excel 文档的最佳方法是什么？
我搜索了许多网站，并为技术人员找到了一些解决方案：
但这需要足够容易让非技术人员使用。
我希望能够将两个文档（Word 模板和链接的 Excel 模板）复制并粘贴到新位置，并让它们以与原始位置相同的方式工作。
我还希望能够仅将 Word 模板复制到新位置并将其链接到该新位置的 Excel 模板。
【问题讨论】：
我最终为一个我很难找到答案的问题写了一个解决方案，所以我想分享最终对我有用的东西。
代码在 word 文档的工作目录中查找，找到第一个 excel 文档（我的工作中每个文件夹只有 1 个 excel 文件，所以这个设置适用于我），并更改所有 OLE 对象的源word 文档以匹配 excel 文档，这使得创建 word/excel 模板对并将它们移动到不同的位置成为可能。
*注意：我使用 Windows 特定的对象/函数进行 I/O，即 MyFile、MyFSO、MyFolder... 等，但我认为制作 I/O 平台不会非常困难不可知论者。
**注意：我也没有真正添加任何错误检查，因为它是一个快速而肮脏的宏，在内部使用以促进可移植性，而且我以前从未使用过 vba，所以垃圾清理等只是一种抛出在那里，如果有办法重构并清理它，请告诉我。
Sub UpdateWordLinks()
Dim newFilePath As Variant
Dim excelDocs As Variant
Dim range As Word.range
Dim shape As shape
Dim section As Word.section
excelDocs = GetFileNamesbyExt(ThisDocument.Path, ".xlsx")
'The new file path as a string (the text to replace with)'
newFilePath = ThisDocument.Path & Application.PathSeparator & excelDocs(1)
Call updateFields(ThisDocument.fields, newFilePath)
For Each section In ThisDocument.Sections
Call updateHeaderFooterLinks(section.headers, newFilePath)
Call updateHeaderFooterLinks(section.Footers, newFilePath)
Next
'Update the links
ThisDocument.fields.Update
Set newFilePath = Nothing
Set excelDocs(1) = Nothing
Set excelDocs = Nothing
Set range = Nothing
Set shape = Nothing
Set section = Nothing
End Sub
Function GetFileNamesbyExt(ByVal FolderPath As String, FileExt As String) As Variant
Dim Result As Variant
Dim i As Integer
Dim MyFile As Object
Dim MyFSO As Object
Dim MyFolder As Object
Dim MyFiles As Object
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = MyFolder.Files
ReDim Result(1 To MyFiles.count)
i = 1
For Each MyFile In MyFiles
If InStr(1, MyFile.Name, FileExt) <> 0 Then
Result(i) = MyFile.Name
i = i + 1
End If
Next MyFile
ReDim Preserve Result(1 To i - 1)
GetFileNamesbyExt = Result
Set MyFile = Nothing
Set MyFSO = Nothing
Set MyFolder = Nothing
Set MyFiles = Nothing
End Function
Function updateHeaderFooterLinks(headersFooters As headersFooters, newFilePath As Variant)
Dim headerFooter As Word.headerFooter
For Each headerFooter In headersFooters
Call updateFields(headerFooter.range.fields, newFilePath)
Next
Set headerFooter = Nothing
End Function
Function updateFields(fields As fields, newFilePath As Variant)
Dim field As field
Dim oldFilePath As Variant
For Each field In fields
If field.Type = wdFieldLink Then
oldFilePath = field.LinkFormat.SourceFullName
field.Code.Text = Replace(field.Code.Text, _
Replace(oldFilePath, "\", "\\"), _
Replace(newFilePath, "\", "\\"))
End If
Next
Set field = Nothing
Set oldFilePath = Nothing
End Function
它允许我将 word 和 excel 文件一起复制粘贴到新位置并运行宏，或者允许我仅复制粘贴 word 文档并运行宏以将其链接到excel 文档在新位置。
**我还应该注意，我只需要查看我们使用的链接的正文和页眉/页脚故事，所以这段代码没有它应该的那么健壮，但我认为它也会很难再添加一两个循环来掩盖任何缺失的故事
干杯！
【讨论】：
如果您仍在寻找在 Excel 和 Word 之间创建可移植链接的方法，我们的 Excel 到 Word 文档自动化插件可能会有所帮助。与通过 Office 进行本地链接不同，您可以：重命名文件、复制/粘贴和重新组织内容、共享链接文件等。同一个 Excel 文档可以更新多个目标 Word 和/或 PowerPoint 报告模板。您只需设置一次链接，即可多次更新。我希望这会有所帮助，您可以通过https://analysisplace.com/Document-Automation 了解更多信息
【讨论】：