Word VBA 提取嵌入文件的标题答案

【问题标题】：Word VBA to extract Captions of Embedded FilesWord VBA 提取嵌入文件的标题
【发布时间】：2017-08-24 18:41:48
【问题描述】：

我正在尝试在 Word docx 中提取所有嵌入的 Excel 文件。我知道我可以通过将 docx 的文件名更改为 zip 来快速完成此操作，然后在 word/embeddings 文件夹中找到所有 Excel 文件。

问题在于 word/embeddings 中的 Excel 文件具有非常通用的文件名（例如，Microsoft_Excel_Macro-Enabled_Worksheet1.xlsm、Microsoft_Excel_Macro-Enabled_Worksheet2.xlsm）而不是原始文件名。然而，原始文件实际上是 csv 而不是 xlsm 文件。

我没有参与创建此文档。我假设他们使用了 Insert -> Object -> Create From File。另外，我使用的是 Word 2010，但根据兼容性检查器，该文档最初是使用 Word 97-2003 创建的，而这些文件后来是使用 Word 2007 嵌入的。

如果我进入 docx，我可以找到原始文件名，右键单击嵌入的文件图标，然后转到启用宏的工作表对象 -> 转换... -> 更改图标... -> 标题

但是，我不想为一堆嵌入的 Excel 文件手动执行此操作。

那么有没有办法使用一些 vba 代码来提取所有嵌入文件的原始文件名列表？然后我可以使用这个列表作为键来重命名通用命名的文件。

【问题讨论】：

当你想在VBA做一些新的事情时，试着点击左下角的记录按钮，记录你需要做的事情。稍后返回并编辑代码以在整个文档上循环。如果您通过上述方法提供可重现的代码，我可以帮助您完成第二部分。
是的，我尝试这样做，但是当我在 Word 中录制宏时，它甚至不允许我右键单击嵌入的文件图标来获取标题。我对 Excel 宏有很多经验，但对 Word 没有。
是的。我试图这样做并意识到这一点。如果您知道批处理脚本，我有一个想法可能对您有用。您可以将扩展名更改为*.zip。然后打开 zip 文件并导航到 document.xml.rels 文件。读取包含@987654324@ 的每一行并将其写入文本文件。如果我必须这样做，我会这样做。如果您决定使用此选项，请注意几点： 1. 7zip 可以读取 zip 文件的内部。 2. 你可以在这里找到很多简单的脚本示例。
我刚刚查看了document.xml.rels，但它看起来也没有给我标题信息。它有一些关系 ID。 Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/package" Target="embeddings/Microsoft_Excel_Macro-Enabled_Worksheet68.xlsm"/><Relationship Id="rId324"
我认为如果可以通过 vba 提取此 Caption 信息，则可能需要 vba 答案，因为我无法从 xml 文件中获取它。

标签： vba excel ms-word

【解决方案1】：

使用vba 我可以让我的代码将所选文件的标题打印到immediate window 中（您可以将其写在其他任何地方）。这是我的代码：

 Sub Caption_Ex()

     If Selection.Type = wdSelectionShape Then
         Selection.ShapeRange(1).ConvertToInlineShape.Select
     End If

     Debug.Print Selection.InlineShapes(1).OLEFormat.IconLabel

 End Sub

这是@user1964692 对整个文档所做的，我将其包含在我的编辑中以供参考：

 Option Explicit

 Dim num As Integer
 Dim AD As Document
 Dim ctr As Integer
 Dim caption_names() as variant
 Dim numObjects As Integer

 Sub Extract()

 Set AD = ActiveDocument

 numObjects = AD.InlineShapes.Count
        ctr = 1

 For num = 1 To numObjects
     If AD.InlineShapes(num).Type = 1 Then
         'it's an embedded OLE type so open it.
         Redim Preserve caption_names(1 to ctr)
         caption_names(ctr) = AD.InlineShapes(num).OLEFormat.IconLabel
         ctr=ctr+1
     End If
 Next num

 End Sub

这是我将通过脚本使用的解决方案：

导航到您*.docx 所在的文件夹并在其中打开cmd。复制带有*.zip扩展名的word文档。

xcopy Doc1.docx *.zip

然后使用7zip 提取cmd 中的文件。您应该将7za.exe 与您的文档放在同一文件夹中。

7za.exe x Doc1.zip -o *.xml.rels -r

xcopy document.xml.rels *.txt

稍后您可以搜索其中包含.xls的行（假设您在C盘，请适当更改路径）：

powershell Command "select-string -path "C:\document.txt" -Pattern ".xls" | select line | out-file C:\lines.txt -append"

您将在lines.txt 文件中找到文件名、行号和包括匹配项在内的整行（即.xls）。这将为您提供您正在查找的文件的名称。

【讨论】：

我在documents.xml.rels 中没有看到与您相同的信息。我所看到的只是我之前在评论中发布的两行的重复。奇怪的是，我试图提取的文件的标题说嵌入文件最初是 *.csv，但由于某种原因它被嵌入为 *.xlsm。
@user1964692 好的，让我检查一下。将这些信息添加到您的问题中会很好。请也回答这个问题。您是在插入对象时创建了新文件还是从文件中创建了它们？
我没有参与创建此文档。我假设他们使用了 Insert -> Object -> Create From File。另外，我使用的是 Word 2010，但根据兼容性检查器，该文档最初是使用 Word 97-2003 创建的，而这些文件后来使用 Word 2007 嵌入。
感谢您的帮助。我根据你的情况想出了一个答案。

【解决方案2】：

这是我最终做的：

Sub Extract()

Dim num As Integer
Dim AD As Document
Set AD = ActiveDocument

Dim numObjects As Integer
numObjects = AD.InlineShapes.Count

Dim caption_names() as variant
ctr = 1
For num = 1 To numObjects
    If AD.InlineShapes(num).Type = 1 Then
        'it's an embedded OLE type so open it.
        Redim Preserve caption_names(1 to ctr)
        caption_names(ctr) = AD.InlineShapes(num).OLEFormat.IconLabel
        ctr=ctr+1
    End If
Next num

End Sub

【讨论】：