最近实习遇到的问题，需要筛一些文件夹出来，手动操作实在是繁琐，以下方法亲测好用。
后期的想法是把这个宏打包一下，变成独立的一个小工具，也许可迁移性会更强。
目前这个只要把目标移动路径和数据库文件放在同一子目录下就可以了，基本上是文件夹之间的移动，配合文件名快速生成还是很强大的，感觉能够提高不少效率。
目标是在access里实现，接下来看看能不能迁移到excel里，不知道会产生什么问题，VBA宏编程这一块比较不熟，慢慢加强一下吧。感觉还是很好用的。至少微软自己的工具可以直接从底层调用，这样的话还是开森。
摘 要:通过引用Microsoft Scripting Runtime动态库， fso.Movefolder函数和自定义函数实现了文件夹的批量移动。
正 文:
一直想将取好文件名称的待办工作移动到已完成工作中，这样就可以直接了当的看出来还有多少工作未完成，一个一个移，确实有点麻烦。如果能实现文件夹的批量移动，那么就可以不费力的将已完成工作移动到指定文件夹。然而搜索了很多实例，都没有可以参考的ACCESS示列，使得我的想法无法实现。但还是功夫不负有心人，经过百度搜索了解了Microsoft Scripting Runtime动态库，及移动文件的相关函数，实现了单个文件的移动，算是有了些头绪，至少知道了用什么函数。
'移动文件夹
Public Sub Movefolder_fso()
Dim fso As New FileSystemObject
Dim strSfolder As String
Dim strDfolder As String
strSfolder = CurrentProject.Path & "\测试1"
strDfolder = CurrentProject.Path & "/MoveFile/"
If Not fso.FolderExists(strSfolder) Then
MsgBox " 文件夹不存在.", vbCritical
Else
fso.Movefolder strSfolder, strDfolder
MsgBox "已将文件移动到 " & strDfolder
End If
Set fso = Nothing
End Sub
后来通过参考批量文件命名的编写思路，先实现单个文件的移动，再逐条检索实现批量移动，写成了一个自定义函数。
'批量文件夹移动
'需要引用Microsoft Scripting Runtime动态库
Public Sub FMovefolder_fso()
Dim fso As New FileSystemObject
Dim strSfolder As String
Dim strDfolder As String
Dim rs As ADODB.Recordset
Dim str As String
Dim i, countY As Integer
str = "select * from tbl_wj where xz=true and (not isnull(bh))"
Set rs = getrs(str)
countY = 0
strDfolder = CurrentProject.Path & "/MoveFile/" '目的文件路径
For i = 0 To rs.RecordCount - 1
strSfolder = CurrentProject.Path & "/" & rs!bh '需要移动的文件路径
If fso.FolderExists(strSfolder) Then
fso.Movefolder strSfolder, strDfolder
countY = countY + 1
With rs
!zt = True
.Update
End With
Else
MsgBox " " & rs!bh & "文件夹不存在", vbCritical
End If
rs.MoveNext
Next
MsgBox "您已移动了" & countY & "个文件，请到相应目录下检查！"
End Sub
经过多交测试后成功。但在使用过程中发现，不能跨越两个本地磁盘，也不能自定义相同磁盘的不同文件夹。还请大家帮忙一起完善。
工程的包在这里下载：从这里下载