您当前的位置:首页 > 零壹零壹 > 技巧网站首页技巧

批量word文件替换内容vba代码

发布时间:2016-02-26编辑:一水阅读(

 

工作中偶尔要一下子就替换掉很多个WORD文档中的内容,在网上下载软件既不安全又麻烦,还是使用VBA的办法比较靠谱,下面是完整代码

一、前期准备

下面是具体操作步骤。

A,首先将需要批量替换的多个Word文档放在同一文件夹下面。

B,新建一空白Word文档,右击空白工具栏,单击“控件工具箱”,就可以看到屏幕上调出的控件工具箱。

C,在控件工具箱上单击“命令按钮”,文档中就放置了一个按钮了。

D,双击该按钮,进入VB代码编写模式,将以下代码复制进去。

二、命令按钮的代码

(网上大部分都是office03版之前的代码,下面是适用之后所有版本的代码)。

Dim ArrFiles()
Dim FileCount%
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
    Dim myPas As String, myPath As String, i As Integer, myDoc As Document
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择目标文件夹"
        If .Show = -1 Then
          myPath = .SelectedItems(1)
        Else
          Exit Sub
        End If
    End With
     'myPas = InputBox("请输入打开密码:")(有密码则去掉'加上这行)
 
    '把找到的文件读入数组中
    Dim fs As Object, fd As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set fd = fs.GetFolder(myPath)
    FileCount = 0
    SearchFiles fd
 
    '循环数组
    For i = 1 To FileCount
        Set myDoc = Documents.Open(FileName:=ArrFiles(i))

           'Set myDoc = Documents.Open(FileName:=ArrFiles(i), Passworddocument:=myPas)(上下两行,有密码用这行)
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = "一水秋风"
            .Replacement.Text = "
www.vkan.net"
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        myDoc.Save
        myDoc.Close
        Set myDoc = Nothing
   Next
    Application.ScreenUpdating = True
End Sub
Sub SearchFiles(ByVal fd As Object)
    Dim fl As Object
    Dim sfd As Object
    For Each fl In fd.Files
        If InStr(Right(fl.Path, Len(fl.Path) - InStrRev(fl.Path, ".")), "doc") > 0 Then
            FileCount = FileCount + 1
            ReDim Preserve ArrFiles(1 To FileCount)
            ArrFiles(FileCount) = fl.Path
        End If
    Next
    If fd.subfolders.Count = 0 Then Exit Sub
    For Each sfd In fd.subfolders
        SearchFiles sfd
    Next
    Set fl = Nothing
    Set sfd = Nothing
End Sub
 

 

关键字词