【VBA脚本】提取word文档中所有批注的信息和待解决状态

前言

关于word文档的工具,之前做过这个:

针对word.docx文档的关键词索引器

这个工具在我设想中的是用来在项目的后期检查文档中是否还有TBD/TODO这类关键词未清理,检查文档的完成状态。而后,继续探索对于文档质量检查的工具,于是我发现我们很多文档的review是通过批注完成的(当然也有借助网站的),而这些批注的待解决状态并不是非常的直观:

尤其是文档较长的时候,需要一条一条的过(当然了,word里也支持跳到下一个未解决)。如果只有一个文档还好,如果你作为交付负责人,要负责许多文档的交付质量时,一个文档一个文档的看肯定是不现实的,因此我觉得有必要做这样一个统计归档的工具。当然,已经有review网站或者平台做了这种事情,所以我这个工具主要是作为练手,或者是没买这类平台的人。

终极构想

图形化界面操作:

1.选取目录,之后递归得到所有word文档;

2.对每一个word文档,抓取所有的批注,包括文档路径、批注页码、行号、批注内容、原文、批注者、批注时间、批注解决状态,其中批注解决状态是需要的核心信息;

3.设置选项,可以只抓取未解决的批注;

4.抓取成功后将信息整理到需要的excel文档中,以供评审。

抓取批注信息

python抓取批注

最开始我想的是用python来抓取docx里的批注信息,也仿写了代码:

def docx_comments_get(file):
	document = ZipFile(file)
	xml = document.read("word/comments.xml")
	wordObj = BeautifulSoup(xml.decode("utf-8"), features="xml")
	texts = wordObj.findAll("w:t")
	for text in texts:
		print(text.text)
pass

def main():
	docx_comments_get("D:\MyWork\python\测试文档.docx")

但是发现这样做只能抓取批注内容,对于其他的信息很难获取,即使打开了docx里comments.xml源文件,里面的内容也很有限:

其他的信息就散落在他的xml文件里,我的确是不太会处理。所以通过python去提取批注的完整信息这条路基本就走不通了。

VBA抓取批注

于是我就转换了一个方向,通过VBA来获取内部的批注信息,微软自己的工具对word的支持应该做的不能差吧。继续这个方向发现确实,VBA可以把一个word内部的批注信息提供的非常完善。通过word的开发工具进入visual basic的编程界面,开始编写宏文件。

下面是我最终的宏代码:


Public Sub exportWordComments_Click()

    FileName = Application.ActiveDocument '文件名.docx
    
    varResult = VBA.Split(FileName, ".")
    FileNameStr = varResult(0) '去除后缀的文件名
    
    Path = Application.ActiveDocument.Path
    FilePath = Path & "\" & FileName '当前文件的完整路径
    LogPath = Path & "\" & FileNameStr & "_comments.txt" '批注信息的输出目录
    'Debug.Print (FilePath)
    If FileName = "False" Then
        Exit Sub
    End If
    
    Rows = ActiveDocument.Comments.Count '总的批注数量
    'Debug.Print (Rows)
    
    Open LogPath For Output As #1 '输出txt文件
    Print #1, "==================================================="
    For i = 1 To Rows
        PageNumber = ActiveDocument.Comments(i).Scope.Information(wdActiveEndPageNumber) '批注在第几页
        CharacterLineNumber = ActiveDocument.Comments(i).Scope.Information(wdFirstCharacterLineNumber) '批注在这页的第几行
        Scope = ActiveDocument.Comments(i).Scope '批注原文
        ScopeComment = ActiveDocument.Comments(i).Range '批注内容
        ScopeDate = ActiveDocument.Comments(i).Date  '批注时间
        ScopeAuthor = ActiveDocument.Comments(i).Contact '批注作者
        ScopeDone = ActiveDocument.Comments(i).Done '批注是否被解决
        
        'Debug.Print ("原文:" & ActiveDocument.Comments(i).Scope) '原文
        'Debug.Print (ActiveDocument.Comments(i).Done)
        'Debug.Print (ActiveDocument.Comments(i).Contact)
        'Debug.Print (ActiveDocument.Comments(i).Creator)
        'Debug.Print (ActiveDocument.Comments(i).Date)
        'Debug.Print (ActiveDocument.Comments(i).Index)
        'Debug.Print (ActiveDocument.Comments(i).Parent)
        'Debug.Print (ActiveDocument.Comments(i).Reference)
        'Debug.Print ("批注内容:" & ActiveDocument.Comments(i).Range) '批注内容
        'Debug.Print (ActiveDocument.Comments(i).IsInk)'是否包含链接
        Print #1, "文件:" & FilePath
        Print #1, "页:" & PageNumber
        Print #1, "行:" & CharacterLineNumber
        Print #1, "原文:" & Scope
        Print #1, "批注:" & ScopeComment
        Print #1, "日期:" & ScopeDate
        Print #1, "批注者:" & ScopeAuthor
        Print #1, "是否解决:" & ScopeDone
        Print #1, "==================================================="
    Next

    Print #1, ""
    Close #1
    
End Sub

执行宏命令后,会在word的目录下出现一个 文件名_comments.txt 文件,打开文件可以看到如下信息:

后记

最关键的第一步打通之后,接下来就是通过python递归所有带处理文件,对每一个文件调用宏生成txt,整理所有txt为excel表,对整个程序做图形界面以便使用。

请待后续~

  • 2
    点赞
  • 5
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 4
    评论
要批量提取所有文档指定关键字对应的内容,可以使用Excel VBA来实现。下面是实现的步骤: 1. 首先,打开一个新的Excel工作簿,按下快捷键ALT+F11,进入VBA编辑器界面。 2. 在VBA编辑器,点击"插入"菜单,选择"模块",在新建的模块编写VBA代码。 3. 创建一个函数,用于提取文档指定关键字对应的内容,代码如下: ``` Function ExtractContentFromDoc(keyword As String, filePath As String) As String Dim wordApp As Object, wordDoc As Object Set wordApp = CreateObject("Word.Application") Set wordDoc = wordApp.Documents.Open(filePath) Dim content As String content = "" For Each paragraph In wordDoc.Paragraphs If InStr(1, paragraph.Range.Text, keyword, vbTextCompare) > 0 Then content = content & paragraph.Range.Text & vbCrLf End If Next paragraph wordDoc.Close wordApp.Quit ExtractContentFromDoc = content End Function ``` 4. 在主模块编写另一个子程序,用于遍历指定文件夹下的所有文档并提取内容,代码如下: ``` Sub BatchExtractContent() Dim folderPath As String Dim keyword As String folderPath = "指定文件夹路径" keyword = "指定关键字" '获取指定文件夹下的所有文档 Dim fileNames As Variant fileNames = Dir(folderPath & "\*.docx") '遍历所有文档并提取内容 Dim fileName As Variant Dim content As String content = "" Do While fileNames <> "" fileName = folderPath & "\" & fileNames content = content & ExtractContentFromDoc(keyword, fileName) & vbCrLf fileNames = Dir Loop '将提取到的内容写入Excel工作表 Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) ws.Range("A1").Value = "文档名称" ws.Range("B1").Value = "提取内容" Dim rowNum As Integer rowNum = 2 Dim docName As Variant docName = Dir(folderPath & "\*.docx") Do While docName <> "" ws.Cells(rowNum, 1).Value = docName ws.Cells(rowNum, 2).Value = content rowNum = rowNum + 1 docName = Dir Loop End Sub ``` 5. 将上述代码复制到VBA编辑器,并替换掉"指定文件夹路径"和"指定关键字"为你自己的文件夹路径和关键字。 6. 关闭VBA编辑器,回到Excel表格,按下快捷键ALT+F8,选择"BatchExtractContent"并点击"Run"按钮,即可开始批量提取文档指定关键字对应的内容。 这样,Excel VBA就可以实现批量提取所有文档指定关键字对应的内容,并将结果保存在Excel工作表

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 4
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

尼德兰的喵

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值