如何一次性更改不同文件夹下多个不同word文档中相同位置的相同标题

mpmpmp777

这有不同word文档，它们分分属于不同文件夹下，素材是暂时放在一个文件夹下了， 素材.rar (525.9 KB, 下载次数: 4)

2014-10-30 17:01 上传

点击文件名下载附件

它们的标题完全相同都是“2013-2014学年上学期段考试卷13级五年一贯制班级《计算机应用基础》”如何设置，可以灵活一次性将这几个文件的标题改为“2014-2015学年上学期段考试卷14级五年一贯制班级《计算机应用基础》”

考卷.rar(262.22 KB, 下载次数: 1)2014-10-30 15:36 上传 下载次数: 1 素材 我这有不同word文档，它们的标题完全相同都是“2013-2014学年上学期段考试卷13级五年一贯制班级《计算机应用基础》”如何设置，可以灵活一次性将这几个文件的标题改为“2014-2015学年上学期段考试卷14级五年一贯制班级《计算机应用基础》”

kqbt

试了下效果，效率太低：

1. Sub kk遍历指定目录及其子目录所有文档()
   
2.   Dim wDia As FileDialog
   
3.   Dim n As Long
   
4.   Dim wDoc As Document
   
5.   Dim wRng As Range
   
6.   Dim wPath As String, wStr As String
   
7.   Set wDia = Application.FileDialog(msoFileDialogFolderPicker)
   
8.   With wDia
   
9.     If .Show = 0 Then Exit Sub
   
10.     wPath = .SelectedItems(1)
    
11.   End With
    
12.   Application.ScreenUpdating = False
    
13.   With Application.FileSearch
    
14.     .NewSearch
    
15.     .LookIn = wPath
    
16.     .SearchSubFolders = True
    
17.     .FileName = "*.docx"
    
18.     '.FileType = msoFileTypeWordDocuments
    
19.     If .Execute() = 0 Then Exit Sub
    
20.       For n = 1 To .FoundFiles.Count
    
21.          Set wDoc = Documents.Open(FileName:=.FoundFiles(n), Visible:=False)
    
22.          Set wRng = wDoc.Range(wDoc.Paragraphs(1).Range.Start, wDoc.Paragraphs(1).Range.End - 1)
    
23.          wStr = Replace(Replace(wRng, "14", "15"), "13", "14")
    
24.          wRng.Delete
    
25.          wRng.InsertAfter wStr
    
26.          wDoc.Close True
    
27.       Next n
    
28.   End With
    
29.   Application.ScreenUpdating = True
    
30.   MsgBox "共修改了 " & n - 1 & " 个文档！", vbExclamation
    
31. End Sub

复制代码

mpmpmp777

非常感谢，运行说，有编译错误，我是粘贴到excel,和word中的宏里的，另外是 wStr = Replace(Replace(wRng, "14", "15"), "13", "14")按我希望的数字任意改变就好了，我用合并邮件的方法做了，改变数据源，就可以改变标题，就是数据源的位置变了之后，不能更新了。如果能做成邮件合并的情形，插入一个域，域里的内容，可通过一个电字表格来控制，电子表格与多个含有word文档的文件夹，同在一个文件夹中。

mpmpmp777

如果文件夹存储的位置发生变化了，数据源存储位子也变了，这时word文档中的标题就不能自动更新了，怎么解决这个问题呢？