我要做个程序。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