如何批量在多个word文件标题后依次添加序号

413191246se

楼主，公文要求不必有 01这样的发文字号，只来1号即可，下面是〈循环遍历文件夹--报告编号〉宏，请备份原文件夹后应用（把所有要编号的文件放到一个文件夹中，打包备份后应用此宏）：

1. Sub 报告编号()
   
2.     On Error Resume Next
   
3.     Dim fd As FileDialog, i As Long, doc As Document, p As String, t As Long, s As Long, j As Paragraph
   
4.     Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
5.     If fd.Show = -1 Then p = fd.SelectedItems(1) Else Exit Sub
   
6.     Set fd = Nothing
   
7.     If MsgBox("是否处理文件夹 " & p & " ?", vbYesNo + vbExclamation, "循环遍历文件夹_报告编号") = vbNo Then Exit Sub
   
8.     With Application.FileSearch
   
9.         .NewSearch
   
10.         .LookIn = p
    
11.         .SearchSubFolders = True
    
12.         .FileName = "*.doc"
    
13.         If .Execute > 0 Then
    
14.             For i = 1 To .FoundFiles.Count
    
15.                 Set doc = Documents.Open(FileName:=.FoundFiles(i))
    
16.                 '---------------------------------------------------------
    
17.                 If ActiveDocument.Paragraphs(2).Range.Characters.Last.Previous.Text = "号" Then
    
18.                     ActiveDocument.Paragraphs(2).Range.Characters.Last.Previous.Select
    
19.                     Selection.Font.Color = wdColorRed '红色
    
20.                     Do
    
21.                         Selection.MoveStart unit:=wdCharacter, Count:=-1
    
22.                     Loop Until Selection.Characters.First Like "[! 　]"
    
23.                     Selection = Replace(Selection, " ", "")
    
24.                     Selection = Replace(Selection, "　", "")
    
25.                     Selection.Characters.Last.InsertBefore Text:=i
    
26.                 End If
    
27.                 '---------------------------------------------------------
    
28.                 doc.Close savechanges:=wdSaveChanges
    
29.             Next i
    
30.             MsgBox "处理完毕！共处理 " & .FoundFiles.Count & " 个文件！", vbOKOnly + vbExclamation, "循环遍历文件夹_报告编号"
    
31.         Else
    
32.             MsgBox "未发现文件！", vbOKOnly + vbCritical, "循环遍历文件夹_报告编号"
    
33.         End If
    
34.     End With
    
35. End Sub

复制代码

_溯洄_

413191246se 发表于 2015-11-8 12:24
楼主，公文要求不必有 01这样的发文字号，只来1号即可，下面是〈循环遍历文件夹--报告编号〉宏，请备份原文 ...

非常感谢您的帮忙，但是还有几个问题想请求您的帮助。1、我这每个子文件夹下一共3个word文件，另两个也需要添加编号。能设置成搜索"xxxxx（2015）第 号"，然后依次添加编号。2、过几天还有几百个报告要出，编号要从256开始。麻烦您了，高人

413191246se

楼主，你前后附件不一致！这不太好。另外，你楼上又有两种格式！这让人有点儿无可适从啊！——另外，子文件夹中有多少文件，没有关系的，反正是按照英文字母顺序来的，会自动编号的。但你的附件，哪一种才是真的？

_溯洄_

413191246se 发表于 2015-11-8 20:51
楼主，你前后附件不一致！这不太好。另外，你楼上又有两种格式！这让人有点儿无可适从啊！——另外，子文件 ...

额，万分抱歉，一开始没有说清楚。我以为你的编程思路是先搜索“（2015）第 号“，然后替换的。每个子文件夹一共3三个word文件。就是一开始的那个加上后面这两个。非常感谢您的帮忙

413191246se

楼主，你的原附件中第二段是（2015）第 号，这样的格式，但你的最新图片则不是，你须提供通用标准样本才好。--现在我单位公文，我都不手动编号了，自动给发文字号编号。

_溯洄_

413191246se 发表于 2015-11-9 16:18
楼主，你的原附件中第二段是（2015）第 号，这样的格式，但你的最新图片则不是，你须提供通用标准样本才好 ...

大神，求你再帮我最后一次吧。下面这段代码只能搜索替换当前文件夹下的，你能修改成包括搜索子文件夹下的么？
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("请输入打开密码：")
With Application.FileSearch
    .LookIn = myPath
    .FileType = msoFileTypeWordDocuments
    If .Execute > 0 Then
      For i = 1 To .FoundFiles.Count
      Dim a As String, b As String
      a = 256 + i
        Set myDoc = Documents.Open(FileName:=.FoundFiles(i), Passworddocument:=myPas)
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
        .Text = "（2015）第 号"
        .Replacement.Text = "（2015）第" & a & "号"
        .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
    End If
End With
Application.ScreenUpdating = True
End Sub

_溯洄_

413191246se 发表于 2015-11-9 16:18
楼主，你的原附件中第二段是（2015）第 号，这样的格式，但你的最新图片则不是，你须提供通用标准样本才好 ...

大神，我胡乱改了您的编程，但是结果编号顺序不正确，第一个和最后一个文件编号正确，中间的不正确，您能看看是什么原因么？
Sub 报告编号()
    On Error Resume Next
    Dim fd As FileDialog, i As Long, doc As Document, p As String, t As Long, s As Long, j As Paragraph
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    If fd.Show = -1 Then p = fd.SelectedItems(1) Else Exit Sub
    Set fd = Nothing
    If MsgBox("是否处理文件夹 " & p & " ?", vbYesNo + vbExclamation, "循环遍历文件夹_报告编号") = vbNo Then Exit Sub
    With Application.FileSearch
        .NewSearch
        .LookIn = p
        .SearchSubFolders = True
        .FileName = "*.doc"
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
             Dim a As String
                a = 50 + i
                Set doc = Documents.Open(FileName:=.FoundFiles(i))
                Selection.Find.ClearFormatting
                Selection.Find.Replacement.ClearFormatting
                '---------------------------------------------------------
                With Selection.Find
               .Text = "（2015）第 号"
               .Replacement.Text = "（2015）第" & a & "号"
               .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
                doc.Save
                doc.Close
            Next i
            MsgBox "处理完毕！共处理 " & .FoundFiles.Count & " 个文件！", vbOKOnly + vbExclamation, "循环遍历文件夹_报告编号"
        Else
            MsgBox "未发现文件！", vbOKOnly + vbCritical, "循环遍历文件夹_报告编号"
        End If
    End With
End Sub

413191246se

楼主，你的文件是公司的公文，现在分散保存在不同的子文件夹中，根据你的代码，我也未搞定。——为什么不把它们放在一个文件夹中呢？这样就好办了。有多少个文件？

_溯洄_

413191246se 发表于 2015-11-10 20:58
楼主，你的文件是公司的公文，现在分散保存在不同的子文件夹中，根据你的代码，我也未搞定。——为什么不把 ...

200多个子文件夹，一个子文件就是一个项目，里面很多文件（word、excel都有），把一个文件的文件都打印出来就是一个整个项目的报告，如果分散开就不好弄了。
我是想在目录文件夹下搜索某个word文件，比如搜索封面word文件，就能把所有的封面word文件搜索出来；然后全选用WinRaR压缩，再在另一个地方解压，每个子文件夹下就只有一个封面word文件了，这时就用一个vb编程搜索“（2015）第 号”依次添加编号(有的是xxxxx第 号，到时在编程里修改就可以了)；最后需要添加编号的word文件修改完了，再合并文件夹把原来的文件覆盖就行了。

413191246se

现在的问题是——编号是编号了，但不是按照文件夹的名称顺序编号的，第001文件夹中《封面》是51号，第002文件夹中《封面》可能是55号，52号的可能在第006文件夹中，这是我解决不了的问题……