使用VBA从Word文档中提取图像

Question

我需要循环一些word文档，并从word文档中提取图像，并将其保存在单独的文件夹中。我尝试过将它们保存为超文本标记语言文档的方法，但它不太适合我的需求。

现在，我使用inlineshapes对象循环浏览图像，然后将它们复制粘贴到publisher文档上，然后将它们保存为图像。但是，在运行脚本时，我会遇到运行时自动化错误。对于使用Publisher运行时库，我尝试了早期绑定和晚期绑定，但都遇到了错误。

谁能告诉我出了什么问题？另外，如果有人能解释为什么我会面临这个错误，那就太好了。根据我的理解，这是由于内存分配，但我不确定。

这是我一直在处理的代码块（fp，dp是文件夹路径，而filename是word文档名。我在另一个子文件夹中循环调用此子文件）：

Sub test(ByVal fp As String, ByVal dp As String, ByVal filename As String)
Dim doc As Document
Dim pubdoc As New Publisher.Document
Dim shp As InlineShape
'Applicathtml" target="_blank">ion.Screenupdating = False
'Dim pubdoc As Object
'Set pubdoc = CreateObject("Publisher.Document")
Set doc = Documents.Open(fp)
With doc
    i = .InlineShapes.Count
    Debug.Print i
End With
For j = 1 To i
    Set shp = doc.InlineShapes(j)
    shp.Select
    Selection.CopyAsPicture
    pubdoc.Pages(1).Shapes.Paste
    pubdoc.Pages(1).Shapes(1).SaveAsPicture (dp & Application.PathSeparator & j & ".jpg")
    pubdoc.Pages(1).Shapes(1).Delete
Next
doc.Close (wdDoNotSaveChanges)
pubdoc.Close
'Application.Screenupdating = True

End Sub

除此之外，如果有人有任何建议，让这更快，我洗耳恭听。提前谢谢！

Answer 1

我不得不改变一些事情，但这将允许在word文档中保存一个图像，并经过几个周期，然后在另一侧变成jpg，而不需要任何空白

filename = ActiveDocument.FullName
saveLocaton = "z:\temp\"
FolderName = "test"
On Error Resume Next
Kill "z:\temp\test_files\*"  'Delete all files
RmDir "z:\temp\test_files"  'Delete folder

ActiveDocument.SaveAs2 filename:="z:\temp\test.html", FileFormat:=wdFormatHTML

ActiveDocument.Close
Kill saveLocaton & FolderName & ".html"
Kill saveLocaton & FolderName & "_files\*.xml"
Kill saveLocaton & FolderName & "_files\*.html"
Kill saveLocaton & FolderName & "_files\*.thmx"

Name saveLocaton & FolderName & "_files\image00" & 1 & ".png" As saveLocaton & FolderName & "_files\" & test2 & "_00" & x & ".jpg"

字。应用程序。可见=真言。应用程序。激活，激活

Answer 2

从从原始源文档创建的已过滤HTML文档中提取图片会更快。但是，你说这不适合你的需要，所以。。。下面的示例代码将在源文档中找到图片并将其粘贴到第二个文档中。

这种类型的代码的速度问题是由CopyPicture从选择命令工作引起的，所以我建议使用范围。当然，无论如何，所需的For/Nexthtml" target="_blank">循环都较慢。

Sub CopyPasteAsPicture()
    Dim doc As Word.Document, iShp As Word.InlineShape, shp As Word.Shape
    Dim i As Integer, nDoc As Word.Document, rng As Word.Range
    Set doc = ActiveDocument
    
    If doc.Shapes.Count > 0 Then
        For i = 1 To doc.Shapes.Count
            Set shp = doc.Shapes(i)
            If shp.Type = msoLinkedPicture Or shp.Type = msoPicture Then
                'if you want only pictures extracted then you have
                'to specify the type
                shp.ConvertToInlineShape
                'if you want all extracted pictures to be in the sequence
                'they appear in the document then you have to convert
                'floating shapes to inline shapes
            End If
        Next
    End If
    
    If doc.Content.InlineShapes.Count > 0 Then
        Set nDoc = Word.Documents.Add
        Set rng = nDoc.Content
        For i = 1 To doc.Content.InlineShapes.Count
            doc.Content.InlineShapes(i).Range.CopyAsPicture
            rng.Paste
            rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
            rng.Paragraphs.Add
            rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
        Next
    End If
End Sub

如果要将所有形状（浮动或内联）作为图像文件放置到文件夹中，那么最好的方法是将源文档另存为过滤后的HTML文档。命令如下：

htmDoc。SaveAs2文件名：=LGPWorking

在上面的示例中，活动文档被分配给变量htmDoc。我给这个新文档指定了一个特定的名称和位置。它的输出不仅是HTML文件，而且是一个同名的目录，并附加了一个“\u Files”标签。“x_文件”目录中包含所有图像文件。

如果您只希望从原始源文档中提取选择性图像，或者如果您希望从多个源文档中提取图像...那么您需要使用上面我分享的代码，以便仅将您希望从一个或多个源文档中提取的图像放入新建Word文档，然后将该新文档保存为筛选的超文本标记语言。

完成例程后，您可以杀死超文本标记语言文档，只留下文件目录。

Answer 3

只要加上。压缩到文件名的末尾，展开文件并查看word/media文件夹。所有文件都将在那里，无需编程。