VBA宏批量处理多个Word文档

最新推荐文章于 2025-02-17 09:58:54 发布

输微

最新推荐文章于 2025-02-17 09:58:54 发布

阅读量9.1k

点赞数 11

分类专栏：其他语言 pc

本文链接：https://blog.csdn.net/qq_19934363/article/details/112860254

版权

pc 同时被 2 个专栏收录

36 篇文章

订阅专栏

其他语言

6 篇文章

订阅专栏

本文档介绍了如何通过VBA宏来批量处理Word文档，包括开启宏、编写宏的步骤，以及一个具体的批量替换内容的代码示例。在实际应用中，代码存在两个问题：无法处理包含特殊字符的文件名和在处理过程中无法冻结屏幕。尽管如此，该方法为批量操作提供了一个基础框架。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

前言

工作里面需要处理上百个Word文档，所以就开始在网上查找宏相关的代码
由于第一次接触宏相关的代码，所以写得肯定不会很好。不过，最后勉强算是解决了问题，为了以后方便查找，就把代码贴上来。

开启、编写宏

在这里插入图片描述

勾选上图中的开发工具，就可以显示宏相关的菜单栏了

点击红框内按钮，就可以开始编写和运行宏了

具体代码

Sub 批量操作WORD()
      Application.ScreenUpdating = False '冻结屏幕，打开各个文件及关闭时屏幕不会晃眼睛，但不知道为什么没有效

    Dim MyFileName, Dic, Did, i, fileCount, startTime, runTime, MyDocumentName
       'On Error Resume Next
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)
    If Not objFolder Is Nothing Then lj = objFolder.self.path & "\"
    Set objFolder = Nothing
    Set objShell = Nothing
    startTime = Time
    Set Dic = CreateObject("Scripting.Dictionary")    '创建一个字典对象
    Set Did = CreateObject("Scripting.Dictionary")
    Dic.Add (lj), ""
    i = 0 'i变量用来控制循环的结束
    Do While i < Dic.Count
        Ke = Dic.keys   '开始遍历字典
        MyFileName = Dir(Ke(i), vbDirectory)    '查找目录
        Do While MyFileName <> ""
            If MyFileName <> "." And MyFileName <> ".." Then
              If (GetAttr(Ke(i) & MyFileName) And vbDirectory) = vbDirectory Then    '如果是次级目录
                  Dic.Add (Ke(i) & MyFileName & "\"), ""  '就往字典中添加这个次级目录名作为一个条目
              End If
            End If
            MyFileName = Dir    '继续遍历寻找
        Loop
        i = i + 1
    Loop
    For Each Ke In Dic.keys
        MyDocumentName = Dir(Ke & "*.doc*")  '填写所指定的文件类型
        Do While MyDocumentName <> ""
            Did.Add (Ke & MyDocumentName), ""
            MyDocumentName = Dir
        Loop
    Next
    Dim worddoc   As Document
    fileCount = 0

    For Each path In Did
        Set worddoc = Documents.Open(path)
        worddoc.Activate
        Call 处理WORD  '调用宏,换成具体操作word的宏
        worddoc.Close True
        fileCount = fileCount + 1
    Next
    Set worddoc = Nothing
    runTime = Time - startTime
    Application.ScreenUpdating = True '解冻屏幕，让屏幕恢复正常刷新，同样也不知道为什么不起效
    MsgBox Minute(runTime) & "分" & Second(runTime) & "秒" & "内处理了" & Str(fileCount) & "个word文档"
End Sub



Sub 处理WORD()
   Set myRange = ActiveDocument.Content
   '下面就是一些替换操作的代码，可以自行更换为需要的代码
   myRange.Find.Execute FindText:="2020", ReplaceWith:="2021", Replace:=wdReplaceAll
   myRange.Find.Execute FindText:="2日", ReplaceWith:="5日", Replace:=wdReplaceAll
   myRange.Find.Execute FindText:="10日", ReplaceWith:="14日", Replace:=wdReplaceAll
   myRange.Find.Execute FindText:="WB200", ReplaceWith:="WB300", Replace:=wdReplaceAll
End Sub