如何用vba代码根据关键字文件夹对资料文档进行分类？

楼主 kevinchengcw	Q: 如何用vba代码根据关键字文件夹对资料文档进行分类？ A: 代码如下： Sub test() Dim FN$, WSH As Object, FSO As Object, mPath$, Str$, Tmp$, Arr, N% Set WSH = CreateObject("wscript.shell") '创建WSH项目用于操作命令行 Set FSO = CreateObject("scripting.filesystemobject") '创建FSO项目用于操作文件 mPath = ThisWorkbook.Path '设定起始目录 FN = Dir(mPath & "\模拟的结果\", vbDirectory) '循环提取指定目录下的关键字目录 WSH.Run Environ("comspec") & " /c dir """ & mPath & "\."" /s/b/a-d>""" & mPath & "\list.txt""", 0, 1 '利用WSH运行命令行命令将起始目录下的文件生成列表清单输出于起始目录下的list.txt列表文件中,并等待命令执行完成后再继续执行代码 Do While FN <> "" '循环找到的各个目录 If FN <> "." And FN <> ".." Then '如果目录不是当前目录"."或上级目录"..",则 With FSO.opentextfile(mPath & "\list.txt") '利用FSO操作打开列表文件 While Not .atendofstream '循环读取直到列表文件末尾 Str = .readline '读取一行数据并赋值给字符串变量 If Trim(Str) <> "" And Not Str Like mPath & "\模拟的结果\" Then '如果读取到的内容是有效数据并且不是结果数据存放目录中的内容,则 If Split(Str, "\")(UBound(Split(Str, "\"))) Like "" & FN & "." Then '判断文件名末尾是否与当前循环到的关键字目录名一致,如果一致则 Tmp = Replace(Str, mPath & "\", "") '替换掉起始目录段 Arr = Split(Tmp, "\") '再依路径分隔符将路径拆分放入数组 Tmp = mPath & "\模拟的结果\" & FN '将结果储存路径串接起来用于判断 For N = LBound(Arr) To UBound(Arr) '循环数组各项 If N < UBound(Arr) Then '当前未到达文件名段(即数组最后一项)时 Tmp = Tmp & "\" & Arr(N) '继续串接路径 If FSO.folderexists(Tmp) = False Then MkDir Tmp '如果结果目录中不存在该目录则创建该目录 Else '当到达最后文件名项时,则移动文件到指定目录 WSH.Run Environ("comspec") & " /c move """ & Str & """ """ & Tmp & """", 0, 1 '如果想保留原目录中的文件就在这里用filecopy End If Next N End If End If Wend .Close '关闭列表文件 End With End If FN = Dir '循环到下一个关键字目录 Loop If Dir(mPath & "\list.txt") <> "" Then Kill mPath & "\list.txt" '删除列表文件 Set FSO = Nothing '清空创建的项目 Set WSH = Nothing MsgBox "处理完成" '显示提示信息 End Sub 详见附件及素材源帖. 复制文件夹和文件到指定的文件夹.rar 该帖已经同步到
2楼 546	k哥的作品收藏
3楼松儿	朝思暮想的奇迹终于发生了！谢谢老师！
4楼 khun84	While Not .atendofstream '循环读取直到列表文件末尾上面这行代码会读取到最好一行吗？还是说到最后一行就不读取文件了？
5楼 kevinchengcw	循环读取文件，到达文件末尾前一直循环