word vba 复制粘贴问题
我要做个程序。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