VBA/VBScript提取Word(*.doc)文件中包含的图片(照片)

VBA/VBScript提取Word(*.doc)文件中包含的图片(照片)

 

要处理的人事简历表是典型的Word文档，其中一人一份doc，里面包含有个人的照片，如果要把里面的照片复制出来就比较麻烦了，一般手动的做法是选择文件另存为，保存类型选择“网页（*.htm; *.html）”，这样就会另存为网页形式，同时会有个以文件名开头，以.files结尾的文件夹，点击进去就可以看到Word里面嵌入的所有资源，包含所需要的图片资源。

值得注意的是该文件夹里同一张图片正常会有两个副本，其中一张图片文件体积较大，另一张图片文件体积较小，显而易见较小体积的文件是Word自动创建的缩略图，在绝大多数情况下我们可能仅仅需要原始的插入图片，那么选择较大体积的图片文件即可，好在我要处理的人事简历表只有员工的一张照片，那么另存为网页后的文件夹也仅仅只有两张图片，一张原始图片，一张缩略图，这两张图片可以通过大小区分。

到这里大家可能对提取Word里面的图片有了大概的思路，如果文件比较少，那么刚才手动另存的方法是可以接受的，但是我所要处理的人事简历表就有好几百份，一份一份手动处理肯定耗时耗力，所以本文接下来将要简单介绍如何编程处理这项任务。

首先对于大批Word文件来袭，第一件事情就是要枚举每份文件，VBScript枚举文件的方式有很多，我就不一一介绍了，感兴趣的可以参考我这篇文章。这里有个注意点就是仅仅筛选扩展名为*.doc或者*.docx的文件，可以通过FileSystemObject组件的GetExtensionName获取，还有一个需要注意的地方就是Word会生成以~$开头的隐藏文件，偏偏这个文件也是doc扩展名结尾的，但该文件不是可用的Word文件，所以也要排除~$打头的文件类型。

下一步要明确将该Word文档另存为网页时保存的位置，因为我们主要是提取Word里插入的图片，另存文件这一部分不需要向用户展示，所以我们可以借助临时目录和临时文件来存储。

获取临时目录和文件名的方法如下：

Set fso = WSH.CreateObject("Scripting.FileSystemObject")
    strTempDir = fso.GetSpecialFolder(2) ' 临时目录路径
    strTempFileName = fso.GetTempName()  ' 临时文件名
    ' 另存为HTML网页的文件路径
    strTempHTMLFileName = fso.BuildPath(strTempDir, strTempFileName & ".html" )
    ' 对应的网页资源文件夹路径
    strTempHTMLDirName = fso.BuildPath(strTempDir, strTempFileName & ".files" )
Set fso = Nothing

然后使用SaveAs对目标Word文件进行另存操作，其中另存类型为wdFormatHTML，这是个常量，具体如下所示，表示不同的保存类型选项。

Const wdFormatDocument                    =  0
Const wdFormatDocument97                  =  0
Const wdFormatDocumentDefault             = 16
Const wdFormatDOSText                     =  4
Const wdFormatDOSTextLineBreaks           =  5
Const wdFormatEncodedText                 =  7
Const wdFormatFilteredHTML                = 10
Const wdFormatFlatXML                     = 19
Const wdFormatFlatXMLMacroEnabled         = 20
Const wdFormatFlatXMLTemplate             = 21
Const wdFormatFlatXMLTemplateMacroEnabled = 22
Const wdFormatHTML                        =  8
Const wdFormatPDF                         = 17
Const wdFormatRTF                         =  6
Const wdFormatTemplate                    =  1
Const wdFormatTemplate97                  =  1
Const wdFormatText                        =  2
Const wdFormatTextLineBreaks              =  3
Const wdFormatUnicodeText                 =  7
Const wdFormatWebArchive                  =  9
Const wdFormatXML                         = 11
Const wdFormatXMLDocument                 = 12
Const wdFormatXMLDocumentMacroEnabled     = 13
Const wdFormatXMLTemplate                 = 14
Const wdFormatXMLTemplateMacroEnabled     = 15
Const wdFormatXPS                         = 18
Const wdFormatOfficeDocumentTemplate      = 23
Const wdFormatMediaWiki                   = 24

对于上述类型，本文不做详细叙述，详情可以参考MSDN相关文档，关于另存的VBScript代码如下所示。

Set objWordApp = WSH.CreateObject("Word.Application")
    objWordApp.Visible = True
' 打开目标Word文件
Set objDoc = objWordApp.Documents.Open(strFileName)
' 另存为HTML文件
    objDoc.SaveAs strTempHTMLFileName, wdFormatHTML
    objDoc.Close
Set objDoc = Nothing
    objWordApp.Quit
Set objWordApp = Nothing

另存成功后，我们就可以通过变量strTempHTMLDirName定位到导出的资源文件夹，找到所需要的图片即可。这里需要再次用到文件枚举，实际上每次导出，Word会很贴心的生成一个XML的文件列表，叫做filelist.xml，所有导出的文件该列表均有记录，如下所示：

<xml xmlns:o="urn:schemas-microsoft-com:office:office">
 <o:MainFile HRef="../rad1378A.tmp.html"/>
 <o:File HRef="image001.jpg"/>
 <o:File HRef="image002.jpg"/>
 <o:File HRef="header.html"/>
 <o:File HRef="filelist.xml"/>
</xml>

另外由于是XML格式的，所以可以通过解析这个文件完成对所有导出资源的处理，得到所需要的图片文件路径，获得所对应图片文件大小，取最大存储体积的图片为最终所需要的图片，相关代码如下所示：

Function GetRealImageFileName(fso, strBaseDir)
    Dim i, objXml, objNode, objChildNode
    Dim strFileListFile, strExtension, strFileName
    strFileListFile = fso.BuildPath(strBaseDir, "filelist.xml")
 
    Set objXml = WSH.CreateObject("Microsoft.XMLDOM")
    objXml.validateOnParse = True
    objXml.Load strFileListFile
    objXml.Async = False
 
    Set objNode = objXml.documentElement
 
    Dim f, strFileName2, strFinalImageFileName, fFinalImageFileSize
 
    fFinalImageFileSize = 0
    strFinalImageFileName = ""
 
    For i = 0 To objNode.childNodes.Length - 1
        Set objChildNode = objNode.childNodes.Item(i)
        If objChildNode.tagName = "o:File" Then
            strFileName = objChildNode.attributes.getNamedItem("HRef").text
            strExtension = UCase(fso.GetExtensionName(strFileName))
            If strExtension = "JPG" Or strExtension = "JPEG" Or _
               strExtension = "GIF" Or strExtension = "BMP" Or _
               strExtension = "PNG" Then
               strFileName2 = fso.BuildPath(strBaseDir, strFileName)
               Set f = fso.GetFile(strFileName2)
 
                   If fFinalImageFileSize < f.Size Then
                      fFinalImageFileSize = f.Size
                      strFinalImageFileName = strFileName2
                   End If
               Set f = Nothing
            End If
        End If
        Set objChildNode = Nothing
    Next
 
    Set objNode = Nothing
    Set objXml = Nothing
 
    GetRealImageFileName = strFinalImageFileName
 
End Function

最后将该图片复制出来即可，这里直接判断最大存储体积的图片为所需要的原始图片是基于每张简历表仅插入一张照片为前提的。

另外别忘了进行扫尾工作，删除另存的网页文件和关联资源文件夹，当然由于是临时目录，使用临时文件清理工具也可以完成此项工作，如果我们代码完美一些，可以编程实现自动删除。

' 删除网页文件
fso.DeleteFile strTempHTMLFileName
' 删除网页文件对应资源文件夹里所有文件
fso.DeleteFile fso.BuildPath(strTempHTMLDirName, "*"), True
' 删除网页文件对应资源文件夹里所有目录
fso.DeleteFolder fso.BuildPath(strTempHTMLDirName, "*"), True
' 删除网页文件对应资源文件夹
fso.DeleteFolder strTempHTMLDirName, True