Word VBA提取embedded式文件的标题

我试图提取Word文档中的所有embedded式Excel文件。 我知道我可以通过将docx的文件名更改为zip，然后在word / embeddings文件夹中find所有的Excel文件来快速完成此操作。

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

我没有参与创build这个文档。 我假设他们使用插入 – >对象 – >从文件创build。 此外，我正在使用Word 2010，但根据兼容性检查器，文档最初是使用Word 97-2003创build的，并且这些文件稍后与Word 2007一起embedded。

我可以find原始文件名，如果我进入docx，右键单击embedded式文件图标，然后转到启用macros的工作表对象 – >转换… – >更改图标… – >标题

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

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

Answer 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 

---

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

导航到您*.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

稍后，您可以search其中包含.xls的行（假设您位于C驱动器中，请适当更改path）：

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

您将在lines.txt文件中find文件名，行号和包含匹配（即.xls ）的整行。 这会给你你正在寻找的文件的名称。

Answer 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