各位在线的高手帮帮忙，如何让下面的一段宏在一个文件夹下面的所有word中自动运行啊

xipick

我现在有一个文件夹里面有许多名字没有规律的word文件，该文件夹好比是 C:\Documents and Settings\Administrator\桌面\新建文件夹，我现在在这个文件夹中的一个word中做了一个宏，也就是定位到第四页，然后查找到1，之后改为2，再次查找到的1改为空，然后再次定位到第四页，查找 临沧 这两个字，改为 昆明 ，然后就是保存。我现在想要这个宏自动对该文件夹下面的所有文件运行一次，请问版主，该如何解决啊，因为我一点都不懂得vba，所以恳请版主帮忙写一下啊，上千个文件需要这么操作啊。急盼。
下面是我用录制的宏代码：

1. Sub 替换()
   
2. '
   
3. ' 替换 宏
   
4. '
   
5. '
   
6.     Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="4"
   
7.     Selection.Find.ClearFormatting
   
8.     Selection.Find.Replacement.ClearFormatting
   
9.     With Selection.Find
   
10.         .Text = "1"
    
11.         .Replacement.Text = "2"
    
12.         .Forward = True
    
13.         .Wrap = wdFindContinue
    
14.         .Format = False
    
15.         .MatchCase = False
    
16.         .MatchWholeWord = False
    
17.         .MatchByte = True
    
18.         .MatchWildcards = False
    
19.         .MatchSoundsLike = False
    
20.         .MatchAllWordForms = False
    
21.     End With
    
22.     Selection.Find.Execute
    
23.     With Selection
    
24.         If .Find.Forward = True Then
    
25.             .Collapse Direction:=wdCollapseStart
    
26.         Else
    
27.             .Collapse Direction:=wdCollapseEnd
    
28.         End If
    
29.         .Find.Execute Replace:=wdReplaceOne
    
30.         If .Find.Forward = True Then
    
31.             .Collapse Direction:=wdCollapseEnd
    
32.         Else
    
33.             .Collapse Direction:=wdCollapseStart
    
34.         End If
    
35.         .Find.Execute
    
36.     End With
    
37.     With Selection.Find
    
38.         .Text = "1"
    
39.         .Replacement.Text = ""
    
40.         .Forward = True
    
41.         .Wrap = wdFindContinue
    
42.         .Format = False
    
43.         .MatchCase = False
    
44.         .MatchWholeWord = False
    
45.         .MatchByte = True
    
46.         .MatchWildcards = False
    
47.         .MatchSoundsLike = False
    
48.         .MatchAllWordForms = False
    
49.     End With
    
50.     With Selection
    
51.         If .Find.Forward = True Then
    
52.             .Collapse Direction:=wdCollapseStart
    
53.         Else
    
54.             .Collapse Direction:=wdCollapseEnd
    
55.         End If
    
56.         .Find.Execute Replace:=wdReplaceOne
    
57.         If .Find.Forward = True Then
    
58.             .Collapse Direction:=wdCollapseEnd
    
59.         Else
    
60.             .Collapse Direction:=wdCollapseStart
    
61.         End If
    
62.         .Find.Execute
    
63.     End With
    
64.     Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="4"
    
65.     With Selection.Find
    
66.         .Text = "临沧"
    
67.         .Replacement.Text = "昆明"
    
68.         .Forward = True
    
69.         .Wrap = wdFindContinue
    
70.         .Format = False
    
71.         .MatchCase = False
    
72.         .MatchWholeWord = False
    
73.         .MatchByte = True
    
74.         .MatchWildcards = False
    
75.         .MatchSoundsLike = False
    
76.         .MatchAllWordForms = False
    
77.     End With
    
78.     Selection.Find.Execute
    
79.     With Selection
    
80.         If .Find.Forward = True Then
    
81.             .Collapse Direction:=wdCollapseStart
    
82.         Else
    
83.             .Collapse Direction:=wdCollapseEnd
    
84.         End If
    
85.         .Find.Execute Replace:=wdReplaceOne
    
86.         If .Find.Forward = True Then
    
87.             .Collapse Direction:=wdCollapseEnd
    
88.         Else
    
89.             .Collapse Direction:=wdCollapseStart
    
90.         End If
    
91.         .Find.Execute
    
92.     End With
    
93.     ActiveDocument.Save
    
94. End Sub

复制代码

sqhsqhli

将你的宏配合下面的宏使用即可，进行批量处理。


Sub s1()
Application.ScreenUpdating = false
Dim MyPath As String, i As Integer, myDoc As Word.Document
  On Error Resume Next
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "选择目标文件夹"
    If .Show = -1 Then
      MyPath = .SelectedItems(1)
    Else
      Exit Sub
    End If
  End With
  With Application.FileSearch
    .LookIn = MyPath
    .FileType = msoFileTypeWordDocuments
    If .Execute > 0 Then
      For i = 1 To .FoundFiles.Count
        Set myDoc = Documents.Open(FileName:=.FoundFiles(i), Visible:=False)
        myDoc.Range.Select
        
    Call 替换
  
        myDoc.Close True
      Next
    End If
  End With
  Application.ScreenUpdating = True
End Sub

tangqingfu

学习ing.
谢谢sqhsqhli兄的分享

xipick

sqhsqhli 发表于 2011-12-13 08:36
将你的宏配合下面的宏使用即可，进行批量处理。

多谢大侠了

xipick

sqhsqhli 发表于 2011-12-13 08:36
将你的宏配合下面的宏使用即可，进行批量处理。

感谢大侠帮忙，但是测试之后，运行没有反应哦，郁闷

sqhsqhli

怎么会没反映呢？

SLC168

sqhsqhli 发表于 2011-12-13 08:36
将你的宏配合下面的宏使用即可，进行批量处理。

谢谢  好用