从文件夹中的所有word文档中提取嵌入文档答案

【问题标题】：Extracting embedded documents from all word documents in a folder从文件夹中的所有word文档中提取嵌入文档
【发布时间】：2017-11-01 20:50:53
【问题描述】：

我是 vba 新手，我有一个问题。我在 word 中编写了一个宏来打开和保存活动文档中的嵌入文档。我写的代码如下：

Sub Extract()

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

    Dim numObjects As Integer
    numObjects = AD.InlineShapes.Count

    'MsgBox numObjects  ' prints "11"

    For num = 1 To numObjects
        If AD.InlineShapes(num).Type = 1 Then
            'it's an embedded OLE type so open it.
            AD.InlineShapes(num).OLEFormat.Open
            AD.InlineShapes(num).OLEFormat.Object.SaveAs FileName:="C:\Users\Ankita\Desktop\New folder\x.xlsx", FileFormat:=51


        End If
    Next num

End Sub

我想做的是提取源文件夹中存在的所有word文档中的所有嵌入文档，并将它们全部保存在目标文件夹中。

我知道我必须访问单词 docs 并循环遍历它们，并具有与上面相同的代码 sn-p，但我该如何编写它。

任何帮助将不胜感激。

【问题讨论】：

标签： vba ms-word

【解决方案1】：

第一步是获取源文件夹中您要从中提取的所有文件的列表。

Sub GetAllFiles(Folder As String, StrArray() As String)
    'Stores all file names from a folder into a string array.
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(Folder)
    i = 1
    'loops through each file in the directory and prints their names and path
    For Each objFile In objFolder.Files
        ReDim Preserve StrArray(i)
        StrArray(i) = objFile.Name
        i = i + 1
    Next objFile

    If i = 1 Then
        ReDim Preserve StrArray(1)
    End If
End Sub

下一步是过滤掉除 Word 文档文件之外的所有文件。

Dim FileSpec(1) As String
FileSpec(0) = Source & "\*.doc"
FileSpec(1) = Source & "\*.docx"

Sub GetFileList(ByRef FileSpec() As String, objDict As Object)
    Dim FileName As String
    objDict.RemoveAll
    On Error GoTo NoFilesFound
    For i = LBound(FileSpec) + 1 To UBound(FileSpec)
        FileName = Dir(FileSpec(i))
'       Loop until no more matching files are found
        Do While FileName <> ""
            If Not objDict.Exists(FileName) Then objDict.Add FileName, 0
            FileName = Dir()
        Loop
    Next i
    If objDict.count = 0 Then GoTo NoFilesFound
Exit Sub

'Error Handler
NoFilesFound:
'ERROR HANDLING
End Sub

这会将所有具有 .doc 或 .docx 扩展名的文件作为键和值 0 添加到字典中。您可以将其更改为以数据作为文件名的任何数字的键，但这是您的选择.

从这里，您需要为字典中的每个项目打开并调用您的 Sub。

Sub OpenAndExtract()
Dim AD As Document
    Documents(ActiveDocument.FullName).Close SaveChanges:=wdDoNotSaveChanges
    For each Key in objDict
        Set Ad = Documents.Open(Source & "\" & Key).Activate
        Call Extract
    Next
End Sub

大致就是这样。请注意，您可能必须更改选择目标文件夹的方式（通过获取参数或设置全局变量等）。我不知道您正在从事的项目的组织结构，因此您可能不得不分段进行，让一部分慢慢工作。另外，我在这里的编辑器中几乎所有这些都是手工编写的，所以我完全有可能在某个地方有一些语法错误。不要把它当作上帝的话，但它应该能让你在实现目标的路上顺利。

【讨论】：