如何运用VBA把指定WROD文件复制到指定文件夹（多层文件夹）

楼主 xmyjk	Q: 1、在某个路径（我叫它为总路径）下有若干个文件夹，如分别为文件夹“ 一、二、三、四”； 2、以上每个文件夹下面，可能还有文件夹，总之是下面的路径比较多，且含有比较多的Word 文件； 3、现在在总路径下面建立一个文件，如叫“目标文件夹”，接着在里面建立一个EXCEL文件，然后写个按钮代码，一点击这个按钮，就把总路径下的所有 Word 文件全部复制到这个“目标文件夹”下面来，且要对复制的Word 文件重新命名，命名方法是：在原来的Word 文件名最后面增加一个括号，括号里面再写上这个Word 所在的路径的最上面那个路径的文件夹名称，这里指的是刚才提到文件夹“ 一、二、三、四”。比如文件夹“一”下面有个Word(该Word可能直接就在“一”路径下面第一层，也有可能在“一”路径下面第二层或其它层)，名叫：“A2360 王二小总经理”，它是以字母开头的，就要被复制过来，然后更名为：“A2360 王二小总经理(一)”，但：Word 文件名的第一个字符，一定要是字母(不分大小写)，才能被复制。 A: Option Explicit Dim i As Long, arr() '定义模块级变量两个，一个是arr数组（用于记录找到的文件），一个是i（扩展数组个数） Sub test() Dim fso, fld As Folder, strpath As String, i%, j&, s$, s1$, m& i = 0 Erase arr Set fso = CreateObject("scripting.filesystemobject") '创建FSO对象 strpath = ThisWorkbook.Path & "\" Set fld = fso.GetFolder(strpath).ParentFolder '将代码工作薄所处位置的上级目录作为查找起点 s = fld.Path & "\" '用s变量计入初始路径 searchfiles fld ' 调用查找程序 If Join(arr) <> "" Then '如果查找到 For j = 1 To UBound(arr) If arr(j) <> "" Then m = m + 1 '计数器加1 s1 = ThisWorkbook.Path & "\" & Split(Split(arr(j), "\|")(1), ".doc")(0) & "(" & Split(Split(Split(arr(j), "\|")(0), s)(1), "\")(0) & ").doc" '将查找文件程序的文件路径和文件名切开，并按题目要求重设新文件名 If Dir(s1) <> "" Then Kill s1 '如果同名文件存在，则删除 FileCopy Split(arr(j), "\|")(0), s1 '利用查找的文件路径，复制文件到代码工作簿的目录下 End If Next End If MsgBox "复制" & m & "个文件" '汇报复制了几个文件。 End Sub Sub searchfiles(ByVal fld As Folder) Dim fil As File, strpath As String, sfd As Folder, flpth, fd As Folder Dim fso Set fso = CreateObject("scripting.filesystemobject") Set fd = fso.GetFolder(ThisWorkbook.Path & "\") '记录代码文件夹位置 For Each fil In fld.Files '历遍传入文件夹内的所有文件 If fil.Name Like "[a-zA-Z]*.doc" And Len(fil.Name) > 13 Then '如果传入文件名符合要求，则用数组记录其路径和文件名 i = i + 1 ReDim Preserve arr(1 To i) arr(i) = fil.Path & "\|" & fil.Name End If Next If fld.SubFolders.Count = 0 Then Exit Sub '如果没有子文件加，退出程序 For Each sfd In fld.SubFolders '历遍目录下的子文件夹 If sfd.Name <> fd.Name Then '代码文件夹避免查找 searchfiles sfd '采用递归方式查找子文件夹 End If Next End Sub 该贴已经同步到在EXCEL中如何用VBA代码把指定WROD文件复制到指定文件夹.rar
2楼 chenlifeng	顶！
3楼 JOYARK1958	謝謝提供學習下載中
4楼学习中	这样也行