word vba 复制粘贴问题

[jiamin_1983]

我要做个程序。A文件夹中有数个（比如9个）格式一样的文件，我要把每个文件中的特定字符串，比如“名字”（每个文件“名字”后跟的人名不同）后的人名依次复制粘贴到B文件夹中的相应文件中。请问该怎么写这个程序呢。我做了个，可是有问题。只能得到A文件夹下当前打开的文档中“名字”后的人名，然后在B文件夹中创建9个文档，其中的人名都一样。程序如下：
Private Sub CommandButton1_Click()

Dim sFolder As String '得文件夹中文件数目及每个文档的名字
Dim td As Documents
Dim i As Long 'iuoikj
Dim x As Integer
Dim arr() As String

With Application.FileSearch
.NewSearch
.LookIn = "D:\wddoc2\wddoc"
.SearchSubFolders = True
.FileName = "*.doc"
If .Execute() > 0 Then
x = .FoundFiles.Count

ReDim arr(1 To x)

For i = 1 To x

ChangeFileOpenDirectory "D:\wddoc2\wddoc\"

arr(i) = Replace(.FoundFiles(i), "D:\wddoc2\wddoc\", "")
'MsgBox Len(arr(i))

'MsgBox arr(i)
arr(i) = Right(arr(i), Len(arr(i)) - 1)
'MsgBox arr(i)


On Error Resume Next
'MsgBox arr(i)
'Application.ActiveDocument.Close
Documents.Open FileName:=arr(i), ConfirmConversions:=False, ReadOnly _
:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate _
:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="" _
, Format:=wdOpenFormatAuto, XMLTransform:=""
Selection.Find.ClearFormatting
With Selection.Find
.Text = TextBox1.Text
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy

ChangeFileOpenDirectory "D:\wddoc2\22\"


Documents.Open FileName:="22.doc", _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto, XMLTransform:=""

Selection.Find.ClearFormatting
With Selection.Find
.Text = "名字"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.PasteAndFormat (wdPasteDefault)

ActiveDocument.SaveAs FileName:="D:\wddoc2\22\" & i & ".doc", FileFormat:=wdFormatDocument, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
ActiveDocument.Close

' Documents.Close FileName = arr(i)
ChangeFileOpenDirectory "D:\wddoc2\wddoc"



Next i
Else
MsgBox "Folder" & sFolder & " contains no required files"
End If
End With

End
End Sub

[ACMAIN_CHM]

你想实现的功能是什么？简单描述一下，毕竟肯花时间去看你的代码的人不多。

QQ群 48866293 OFFICE应用挖掘
MS OFFICE(ACCESS\EXCE\WORD等应用技术探讨与交流！技术群,请阅群论坛中的《踢人规则》

[jiamin_1983]

把一个文件夹内的相同格式的文件，其中每个文件内特定字符串后的内容复制到另一个文件夹中的文件中。比如A文件夹内有5个文件，那就把这5个文件中特定字符串后的内容依次复制粘贴到B文件夹中的5个文件中去。

[jiamin_1983]

A文件夹内文档格式：
摄像机是的疯狂哦iwe是奥斯卡v
人
名字：史之郎了
性别：男
就 nx.c 啊为二 感觉为二
为日常

B文件夹内文档格式：
阿嫂可
速度反馈；阿合格；
萨多克飞机；阿可。，；可怜见阿嫂独立位；；阿联赛可能；劳动法；合格率；卡
23413

151
3
萎缩萨多高
卢卡斯的肌肤；卡拉苏加德开始的； iwr
名字：

性别：
沃尔克兰你说你的温柔
王二
Wrtq
Qwertq

[hyxlyxq]

不太明白，看看有没有高手来解答！

[不想低调]

糊涂了

[宋翔]

这个还是发文档实际测试一下比较好，否则写出来很可能是做无用功。

[weeqeeyee]

初涉VBA，学习学习。

[frankbj]

解决了没有？没解决的话，把实例发过来，我给你看看。
邮箱：[e-mail]

[jiamin_1983]

解决了。呵呵
不过还是有些可以改进的地方。谢谢大家。