[已解决]请求赐教！移动文件中的文件

松儿

求教，移动。.rar (43.06 KB, 下载次数: 58)

2012-6-9 07:07 上传

点击文件名下载附件 移动汇总中的汇总，并以文件夹的名称给被移动的文件命名。将文件移动到自动生成的文件夹中，自动生成的文件夹命名为“汇总”。

最佳答案

月排行榜 / 总排行榜

mxg825

2012-6-9 14:47

早上网络太卡 无法上传附件。。。现在补上！ 求教，提取。.rar (55.87 KB, 下载次数: 265)

2012-6-9 14:47 上传

点击文件名下载附件

跳转到最佳答案楼层

mxg825

1. Sub ListSubFolder() 'MXG825 2012-6-9
   
2. Dim strPath As String, strTmp As String
   
3. Dim oldTmp As String, newTmp As String
   
4. strPath = ThisWorkbook.Path & ""
   
5. If Dir(strPath & "汇总", 16) = Empty Then '汇总文件夹是否存在
   
6. MkDir strPath & "汇总" '建一个
   
7. End If
   
8. strTmp = Dir(strPath & "*", vbDirectory) '列出所有目录
   
9. Do While strTmp <> "" '历遍全部文件夹
   
10. '以vbDirectory属性来调用Dir时，不能连续地返回子目录，所以使用GetAttr来判断结果是否为目录
    
11. If GetAttr(strPath & strTmp) And vbDirectory Then
    
12. 
    
13. On Error GoTo NextTmp '防文件不存在 跳转词句
    
14. If InStr(1, "汇总，提取.xls..", strTmp) = 0 Then '剔除 汇总文件夹 和提取 工作薄
    
15. oldTmp = strPath & strTmp & "\汇总\汇总.xls" '原文件路径
    
16. newTmp = strPath & "\汇总" & strTmp & ".xls" '新文件路径
    
17. FileCopy oldTmp, newTmp '复制 重命名文件
    
18. 'Debug.Print strPath & strTmp
    
19. End If
    
20. End If
    
21. NextTmp:
    
22. strTmp = Dir
    
23. Loop
    
24. End Sub

复制代码

mxg825

早上网络太卡 无法上传附件。。。现在补上！ 求教，提取。.rar (55.87 KB, 下载次数: 265)

2012-6-9 14:47 上传

点击文件名下载附件

松儿

mxg825 发表于 2012-6-9 14:47
早上网络太卡 无法上传附件。。。现在补上！

正是，真好。谢谢！