Board logo

标题: [原创] VBS转换 Word 2007 文档(.docx)为文本文件 [打印本页]

作者: Spring    时间: 2013-2-1 17:50     标题: VBS转换 Word 2007 文档(.docx)为文本文件

后缀名有个X的Office文档都是采用xml格式存储的,打包成一个zip压缩文件。微软官方也给出了相关的规则,因此不用安装office套件,就可能读取文档内容。
这个想法很早就有,但是没有去试验过,
看到 tmplinshi 发了一个 xdoc2txt 转 txt 的工具(http://bathome.net/thread-22123-1-1.html)里面提到不依赖office,于是就试着写了一个解析 word 2007 文档的脚本,
在制作过程中发现如果要实现很多细节的东西就会写的非常麻烦,于是就简略的弄了一下,比如项目编号只支持中文、罗马字、英文字母,并且最大39。

在这里我想提倡一下大家多使用xml,不是所有的东西都适合用文本的方式,用正则表达式之类的去处理,现在及以后很多东西都会是 xml 格式的,学会这个干事会非常方便。
  1. Option Explicit
  2. If WScript.Arguments.Count = 0 Then
  3.     WScript.Echo "Spring Brother reminds you: docx2txt.vbs DocxFile"
  4.     WScript.Quit
  5. End If
  6. Dim docxFile
  7.     docxFile = WScript.Arguments(0)
  8.    
  9. ' 项目编号格式。0=左端缩进,1=完整编号
  10. Dim numberingType
  11.     numberingType = 0
  12. ' 编号与正文之间的分隔
  13. Dim numberingGap
  14.     numberingGap = vbTab
  15. ' 单元格内的换行用此字符串代替
  16. Dim inTdWrap
  17.     inTdWrap = vbCrLf
  18.    
  19. Const FSO_TEMPORARY_FOLDER          = 2
  20. Const DOCX_CONTENT_PATH             = "word"
  21. Const DOCX_CONTENT_FILE             = "document.xml"
  22. Const DOCX_NUMBERING_FILE           = "numbering.xml"
  23. Const COPY_NO_DIALOG                = 4
  24. Const ForWriting                    = 2
  25. Const TristateTrue                  = -1
  26. Dim sa, fso, docx, pxml, nfmt, nums, ncvt
  27.     Set sa   = CreateObject("Shell.Application")
  28.     Set fso  = CreateObject("Scripting.FileSystemObject")
  29.     Set docx = CreateObject("Msxml2.DOMDocument")
  30.     Set pxml = CreateObject("Msxml2.DOMDocument")
  31.     Set nfmt = CreateObject("Msxml2.DOMDocument")
  32.     Set nums = CreateObject("Scripting.Dictionary")
  33.     Set ncvt = New RegExp
  34.         ncvt.Pattern = "^(.*)\%(\d+)(.*)$"
  35. ' 初始化变量
  36. ' 原文件夹,导出文件,临时文件夹,临时文件,文档内容,文档编号
  37. Dim origFolder, textFile, tempFolder, tempFile, content, numbering
  38.     origFolder   = fso.GetFile(docxFile).ParentFolder.Path
  39.     textFile     = fso.BuildPath(origFolder, fso.GetFile(docxFile).Name & ".txt")
  40.     tempFolder   = fso.GetSpecialFolder(FSO_TEMPORARY_FOLDER)
  41.     tempFile     = fso.BuildPath(tempFolder, fso.GetFile(docxFile).Name & ".zip")
  42.     content      = fso.BuildPath(tempFolder, DOCX_CONTENT_FILE)
  43.     numbering    = fso.BuildPath(tempFolder, DOCX_NUMBERING_FILE)
  44. ' 复制原 docx 文档到临时文件夹
  45. fso.CopyFile docxFile, tempFile, True
  46. ' 从临时文件中提取出内容和编号格式文件
  47. With sa.NameSpace(fso.BuildPath(tempFile, DOCX_CONTENT_PATH))
  48.     If fso.FileExists(content) Then fso.DeleteFile content, True
  49.     sa.NameSpace(tempFolder).CopyHere .ParseName(DOCX_CONTENT_FILE), COPY_NO_DIALOG
  50.     If fso.FileExists(numbering) Then fso.DeleteFile numbering, True
  51.     sa.NameSpace(tempFolder).CopyHere .ParseName(DOCX_NUMBERING_FILE), COPY_NO_DIALOG
  52.     Do     ' 检查文件是否已经复制完成
  53.         WScript.Sleep 100
  54.     Loop Until fso.FileExists(content) And fso.FileExists(numbering)
  55. End With
  56. ' 载入编号格式
  57. nfmt.load numbering
  58. ' 载入文档内容
  59. docx.load content
  60. Dim f, ps, p, pxs, px, n, l, iNum, iLvl, i
  61. ' 创建 Unicode 编码文本文件
  62. Set f = fso.OpenTextFile(textFile, ForWriting, True, TristateTrue)
  63. Set ps = docx.documentElement.selectNodes("//w:p")
  64. For Each p In ps
  65.     ' 在独立空间中处理
  66.     pxml.loadXML p.xml
  67.     ' 解析编号
  68.     Set l = pxml.selectSingleNode("//w:ilvl")
  69.     Set n = pxml.selectSingleNode("//w:numId")
  70.     If Not n Is Nothing Then
  71.         ' 编号
  72.         iNum = n.attributes.Item(0).value
  73.         ' 级次
  74.         iLvl = l.attributes.Item(0).value
  75.         If numberingType = 1 Then
  76.             For i = 0 To iLvl - 1
  77.                 f.Write GetNumbering(iNum, i, False)
  78.             Next
  79.         End If
  80.         f.Write GetNumbering(iNum, iLvl, True)
  81.         f.Write numberingGap
  82.     End If
  83.     ' 获取文本
  84.     Set pxs = pxml.selectNodes("//w:t")
  85.     For Each px In pxs
  86.         f.Write px.text
  87.     Next
  88.     ' 切换单元格或段落换行
  89.     If (Not p.parentNode Is Nothing) And (p.parentNode.nodeName = "w:tc") Then
  90.         If p.nextSibling Is Nothing Then
  91.             f.Write vbTab
  92.         Else
  93.             f.Write inTdWrap
  94.         End If
  95.         If p.parentNode.nextSibling Is Nothing Then f.WriteBlankLines 1
  96.     Else
  97.         f.WriteBlankLines 1
  98.     End If
  99. Next
  100. f.Close
  101. WScript.Echo textFile
  102. '*****************************************************************************
  103. '* 获取一个编号
  104. '************************
  105. Function GetNumbering(n, l, isNext)
  106.     Dim k, v, fmt, num, snum, ms, m, i
  107.         k = "N" & n & "L" & l
  108.     If nums.Exists(k) Then
  109.         v = nums.Item(k)
  110.         If isNext Then v(3) = v(3) + 1
  111.         nums.Item(k) = v
  112.     Else
  113.         fmt = FindNumberingFormat(n, l)
  114.         v = Array(k, fmt(3), fmt(4), fmt(2))
  115.         nums.Add k, v
  116.     End If
  117.     num = v(3)
  118.     Set ms = ncvt.Execute(v(2)).Item(0).SubMatches
  119.     ' 编号前后的间隔字符串
  120.     Dim indent
  121.         indent = vbTab
  122.     Dim sp, lv, st
  123.         sp = ms.Item(0)
  124.         lv = ms.Item(1)
  125.         st = ms.Item(2)
  126.     snum = ""
  127.     ' 从第二级开始才需要缩进
  128.     If numberingType = 0 Then
  129.         For i = 2 To lv
  130.             snum = snum & indent
  131.         Next
  132.     End If
  133.     snum = snum & sp & Num2No(num, v(1)) & st
  134.     GetNumbering = snum
  135. End Function
  136. '* 获取一个编号格式
  137. '* 返回:[编号, 级次, 起始值, 类型, 格式]
  138. '*****************************************
  139. Function FindNumberingFormat(numId, lvlId)
  140.     Dim num, abstrNumId, abstrNum, isMultilevel, currLvl, start, numFmt, lvlText
  141.     Set num = nfmt.documentElement.selectSingleNode("//w:num[@w:numId='" & numId & "']")
  142.     ' 如果不存在返回空的
  143.     If num Is Nothing Then
  144.         FindNumberingFormat = Array(numId & "_" & lvlId, -1, "", "")
  145.         Exit Function
  146.     End If
  147.     ' 引用的编号
  148.     abstrNumId = num.selectSingleNode("w:abstractNumId").attributes.Item(0).value
  149.     Set abstrNum = nfmt.documentElement.selectSingleNode("//w:abstractNum[@w:abstractNumId='" & abstrNumId & "']")
  150.     ' 单一编号还是复合编号
  151.     isMultilevel = abstrNum.selectSingleNode("w:multiLevelType").attributes.Item(0).value
  152.     If LCase(isMultilevel) = "singlelevel" Then
  153.         Set currLvl = abstrNum.selectSingleNode("w:lvl")
  154.     Else
  155.         Set currLvl = abstrNum.selectSingleNode("//w:lvl[@w:ilvl='" & lvlId & "']")
  156.     End If
  157.     ' 确切的编号
  158.     With currLvl
  159.         start   = .selectSingleNode("w:start").attributes.Item(0).value
  160.         numFmt  = .selectSingleNode("w:numFmt").attributes.Item(0).value
  161.         lvlText = .selectSingleNode("w:lvlText").attributes.Item(0).value
  162.     End With
  163.     FindNumberingFormat = Array(numId, lvlId, start, numFmt, lvlText)
  164. End Function
  165. '* 转换数字为编号(仅支持 1~39 的整数)
  166. '*************************************
  167. Function Num2No(n, sType)
  168.     Dim canConvert, arr, g, s, m, r, i
  169.         canConvert = True
  170.     Select Case sType
  171.         Case "chineseCountingThousand"
  172.             arr = Array("", "一", "二", "三", "四", "五", "六", "七", "八", "九")
  173.             g = "十"
  174.         Case "chineseLegalSimplified"
  175.             arr = Array("", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
  176.             g = "拾"
  177.         Case "lowerRoman"
  178.             arr = Array("", "i", "ii", "iii", "iv", "v", "vi", "vii", "viii", "ix")
  179.             g = "x"
  180.         Case "upperRoman"
  181.             arr = Array("", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")
  182.             g = "X"
  183.         Case "lowerLetter"
  184.             g = 96
  185.         Case "upperLetter"
  186.             g = 64
  187.         Case Else
  188.             canConvert = False
  189.     End Select
  190.     If canConvert Then
  191.         If n <= 9 Then
  192.             If sType = "lowerLetter" Or sType = "upperLetter" Then
  193.                 s = Chr(g + n)
  194.             Else
  195.                 s = arr(n)
  196.             End If
  197.         ElseIf n <= 39 Then
  198.             If sType = "lowerLetter" Or sType = "upperLetter" Then
  199.                 m = Fix(n / 26)
  200.                 r = n Mod 26
  201.                 s = Chr(m + g) & Chr(r + g)
  202.             Else
  203.                 m = Fix(n / 10)
  204.                 r = n Mod 10
  205.                 If sType = "lowerRoman" Or sType = "upperRoman" Then
  206.                     For i = 1 To m
  207.                         s = s & g
  208.                     Next
  209.                     s = s & arr(r)
  210.                 Else
  211.                     s = arr(m) & g & arr(r)
  212.                 End If
  213.             End If
  214.         Else
  215.             s = n
  216.         End If
  217.     Else
  218.         s = n
  219.     End If
  220.     Num2No = s
  221. End Function
复制代码

作者: zhangmi    时间: 2013-2-25 11:17

很棒的东西,感谢分享
作者: huwei96    时间: 2024-3-5 09:04

这个牛逼了




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2