VBA宏批量处理多个Word文档

60 阅读 0 评论 40 点赞

我是靠谱客的博主开放发箍，最近开发中收集的这篇文章主要介绍VBA宏批量处理多个Word文档，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

前言

工作里面需要处理上百个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