word一键替换脚本（多文件归档，批量替换）

word一键替换脚本

多文件归档，批量替换

Sub ReplaceTextInAllDocuments()

    Dim currentDirectory As String
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object


    ' 替换公司名称
    Dim company As String
    Dim find_company As String
    ' 替换项目编号
    Dim xm_bianhao As String
    Dim find_xm_bianhao As String
    ' 替换系统名称
    Dim system_name As String
    Dim find_system_name As String
    ' 替换备案证编号
    Dim baz_bianhao As String
    Dim find_baz_bianhao As String
    ' 替换发放日期
    Dim first_day As String
    Dim find_first_day As String
    ' 替换项目负责人
    Dim main_man As String
    Dim find_main_man As String
    ' 替换项目参与人
    Dim xm_man As String
    Dim find_xm_man As String
    ' 替换测评月份
    Dim xm_month As String
    Dim find_xm_month As String
    ' 替换公司地址
    Dim com_addr As String
    Dim find_com_addr As String
    ' 替换文件编号
    Dim wj_num As String
    Dim find_wj_num As String
    ' 替换现场时间
    Dim xc_time As String
    Dim find_xc_time As String
    ' 替换现场时间
    Dim xc_dengji As String
    Dim find_xc_dengji As String

    ' 公司名称
    company = "XXXXXXXXXXX公司"
    ' 项目编号
    xm_bianhao = "XXXX-1000000001-240001-24-0000-01"
    ' 系统名称
    system_name = "XXXX系统"
    ' 备案证编号
    baz_bianhao = "1000000001-240001"
    ' 项目第一天
    first_day = "2024年6月24日"
    ' 项目负责人
    main_man = "张三"
    ' 项目参与人
    xm_man = "张三、李四、王五"
    ' 测评月份
    xm_month = "2024年6月"
    ' 公司地址
    com_addr = "新疆"
    ' 文件编号
    wj_num = "1000000001-240001-24-xxxx-01"
    ' 现场时间
    xc_time = "2024年01月01日～01月02日"
    ' 系统等级
    xc_dengji = "三"

    
    ' 定义被替换的数据
    find_company = "GSMC"
    find_xm_bianhao = "XMBH"
    find_system_name = "XTMC"
    find_baz_bianhao = "BAZBH"
    find_first_day = "ZBDYT"
    find_main_man = "XMFZR"
    find_xm_man = "XMCYR"
    find_xm_month = "XMYF"
    find_com_addr = "GSDZ"
    find_wj_num = "WJBH"
    find_xc_time= "XCTIME"
    find_xc_dengji = "DENGJI"

    ' 调用函数，进行替换
    ReplaceText find_company, company
    ReplaceText find_xm_bianhao, xm_bianhao
    ReplaceText find_system_name, system_name
    ReplaceText find_baz_bianhao, baz_bianhao
    ReplaceText find_first_day, first_day
    ReplaceText find_main_man, main_man
    ReplaceText find_xm_man, xm_man
    ReplaceText find_xm_month, xm_month
    ReplaceText find_com_addr, com_addr
    ReplaceText find_wj_num, wj_num
    ReplaceText find_xc_time, xc_time
    ReplaceText find_xc_dengji, xc_dengji

    ' 获取当前目录
    currentDirectory = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")


    ' 创建文件系统对象
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    ' 获取当前目录
    Set objFolder = objFSO.GetFolder(currentDirectory)

    ' 循环处理当前目录下的所有Word文档
    For Each objFile In objFolder.Files
        If objFSO.GetExtensionName(objFile.Path) = "docx" Then
            ' 打开Word文档
            Documents.Open objFile.Path

                
                ReplaceText find_company, company
                ReplaceText find_xm_bianhao, xm_bianhao
                ReplaceText find_system_name, system_name
                ReplaceText find_baz_bianhao, baz_bianhao
                ReplaceText find_first_day, first_day
                ReplaceText find_main_man, main_man
                ReplaceText find_xm_man, xm_man
                ReplaceText find_xm_month, xm_month
                ReplaceText find_com_addr, com_addr
                ReplaceText find_wj_num, wj_num
                ReplaceText find_xc_time, xc_time
                ReplaceText find_xc_dengji, xc_dengji


            ' 保存并关闭文档
            ActiveDocument.Save
            ActiveDocument.Close
        End If
    Next

    ' 释放对象
    Set objFSO = Nothing
    Set objFolder = Nothing
    Set objFile = Nothing
End Sub

Sub ReplaceText(strFind As String, strReplace As String)
    Dim doc As Document
    
    ' 循环处理当前打开的所有Word文档
    For Each doc In Documents
        ' 开始替换文字
        With doc.Content.Find
            .Text = strFind
            .Replacement.Text = strReplace
            .Execute Replace:=wdReplaceAll
        End With
    Next doc
End Sub