Question

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

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这个词并循环浏览它们并拥有与上面相同的代码片段，但我究竟该如何编写它。

任何帮助都将不胜感激。

Answer 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扩展名的所有文件添加到Dictionary作为键，值为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

这就是粗略的。请注意，您可能需要更改选择目标文件夹的方式（通过参数或设置全局变量等）。我不知道你正在进行的项目的组织，所以你很可能不得不分步进行，让一部分工作缓慢。另外，我在这里的编辑器中手工编写了这几乎所有这些，所以我完全有可能在某处出现一些语法错误。不要把它当作神的话语，但是它应该能帮助你实现目标。

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

1 个答案: