最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

vbscript - Extract Embedded Files from Word Documents in a Folder - Stack Overflow

programmeradmin0浏览0评论

I will preface this question with I have very little experience with coding and much of this code is pulled from other questions but I can't seem to get it to work for me.

I am trying to extract embedded files from multiple Word documents in a folder and save them to that folder. When I try to run the code I get nothing, no errors and no extracted files.

Sub Main()
    
    GetAllFiles CurDir
    GetFileList
    OpenAndExtract
    
End Sub

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

    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

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

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

Sub GetFileList(ByRef FileSpec(), objDict)
    Dim FileName
    objDict.RemoveAll
    On Error GoTo 0
    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
    If objDict.count = 0 Then Exit Sub

End Sub

Sub OpenAndExtract()
    Dim AD
    Documents.Close (wdDoNotSaveChanges)
    For each Key in objDict
        Set Ad = Documents.Open(Source & "\" & Key).Activate
        Call ExtractAndSaveEmbeddedFiles
    Next
End Sub

Sub ExtractAndSaveEmbeddedFiles()
  Dim objEmbeddedShape
  Dim strShapeType, strEmbeddedDocName
  Dim objEmbeddedDoc
 
  With ActiveDocument
  For Each objEmbeddedShape In .InlineShapes
 
  '  Find and open the embedded doc.
  strShapeType = objEmbeddedShape.OLEFormat.ClassType
  objEmbeddedShape.OLEFormat.Open
 
  '  Initialization
  Set objEmbeddedDoc = objEmbeddedShape.OLEFormat.Object
 
  '  Save embedded files with names as same as those of icon label.
  strEmbeddedDocName = objEmbeddedShape.OLEFormat.IconLabel
  objEmbeddedDoc.SaveAs CurDir() & "\" & strEmbeddedDocName
  objEmbeddedDoc.Close
 
  Set objEmbeddedDoc = Nothing
 
  Next
  End With
End Sub
发布评论

评论列表(0)

  1. 暂无评论