[求助]提取3000个文件中的图片并另存...

周日游鱼

有一个目录，存储的是产品简介，每个产品为一个Word文件（文件名即为产品编码），每个文件中附有该产品的1或多张图片（文件中未使用公司logo等其它任何图片，且以单张图片形式居多）。

现需在系统中录入产品信息，因此需要先将各图片提取出来作为链接。而使用“打开文件-->另存为html-->选取图片”这样的方法就太慢了！

各位知道是否有什么方法或者第三方软件，可以方便地提取出图片，并以文件名的形式存储。例如：

假设文件“Prod-001.doc”内有两张图片，则可以存储成：prod-001-1.jpg、prod-001-2.jpg这样的形式？

如有困难，只提取第一张图片也可以。

谢谢！

周日游鱼

想到处理方法了。

这个问题的关键在于：将Word文件转换为html格式。因此只要找到一款软件，可以支持批量转换即可。类似“Ultra PPT to HMTL convert”等均可以完成此功能。

然后，就可以用DOS命令“dir /b *.jpg > lista.bat”取出带路径的jpg文件，然后用Excel打开此文件，修改成“ren <路径>\1.jpg <路径>.jpg”的形式，再执行即可改名。

最后，将所有的jpg文件搜集在一起即可。

sylun

可试试运行如下过程
Sub test()
'批量提取指定目录中所有doc文档中的图片

    Dim odoc As Document, ndoc As String, odir1 As String, odir2 As String
    Dim temp1 As String, temp2 As String, ndir As String, njpg As String, i As Integer
    On Error Resume Next
    Application.ScreenUpdating = False
    ChDrive "E"  '设置当前驱动器
    odir1 = "E:\ee\"  '指定doc文档存放位置
    odir2 = "E:\eee\"  '指定临时文件存放位置
    ChDir odir1  '确定搜索doc文档的路径
    ndoc = Dir("*.doc")  '搜索当前目录中所有doc文档
    Do While ndoc <> ""  '在指定目录内各doc文档循环操作
        Set odoc = Documents.Open(odir1 & ndoc)
        '如果文档中有嵌入式图形或浮动图形对象，则将文档临时另存为网页文件
        If odoc.InlineShapes.Count > 0 Or odoc.Shapes.Count > 0 Then
'        odoc.SaveAs FileName:=odoc.Path & "e\" & Left(odoc, Len(odoc) - 4) & ".htm", FileFormat:=wdFormatFilteredHTML
        odoc.SaveAs FileName:=odir2 & Left(odoc, Len(odoc) - 4) & ".htm", FileFormat:=wdFormatHTML
        End If
        temp1 = temp1 & vbTab & odoc.FullName  '以字符串记录所有另存的文件名（含路径）
        odoc.Close False  '关闭当前文档
        ndoc = Dir()
    Loop
    '搜索上述指定＂另存为＂文件夹中所有以＂.files＂字符串结尾的子文件夹
    ndir = Dir(odir2 & "*.files", vbDirectory)
    Do While ndir <> ""
        temp2 = temp2 & vbTab & odir2 & ndir  '以字符串记录搜索到的所有符合条件的子文件夹名称
        ndir = Dir()
    Loop
    For i = 1 To UBound(Split(temp2, vbTab))  '依次搜索上述各子文件夹中的JPG图像文件
        njpg = Dir(Split(temp2, vbTab)(i) & "\*.jpg")
        Do While njpg <> ""
            '将搜索到的图像文件另存于指定文件夹（暂定为原doc文档存放位置）
            '图像文件命名规则设为：文件名+原自动生成图片的数字编号部分
            FileCopy Split(temp2, vbTab)(i) & "\" & njpg, _
                odir1 & Replace(Replace(Split(temp2, vbTab)(i), odir2, ""), ".files", "") & "_" & Replace(njpg, "image", "")
            njpg = Dir()
        Loop
    Next i
    '删除临时另存的文件
    For i = 1 To UBound(Split(temp1, vbTab))
        Kill Split(temp1, vbTab)(i)
        Kill Split(temp2, vbTab)(i) & "\*.*"
        RmDir Split(temp2, vbTab)(i)
    Next i
    Application.ScreenUpdating = True
End Sub
有个问题尚未解决：将doc文档另存为网页时，原文档中的每张图片对应有2个JPG文件，保存为“筛选过的网页”时，虽可一一对应，但图片像素不高，有待补充。测试版本为word2003。

[此贴子已经被作者于2007-5-23 17:44:57编辑过]

周日游鱼

谢谢sylun了，你的是正解，我的算是“曲线救国”.

sylun

QUOTE:

以下是引用周日游鱼在2007-5-24 8:25:55的发言：
谢谢sylun了，你的是正解，我的算是“曲线救国”.

其实论坛中已有多种处理方法，我的只是初级的，只针对一种图像格式，练练手而已，谈不上正解。

cuteword

图片像素不高非常容易解决，将图片还原reset后另存。如果本来就被压缩就没有救了！