一直想将取好文件名称的待办工作移动到已完成工作中,这样就可以直接了当的看出来还有多少工作未完成,一个一个移,确实有点麻烦。如果能实现文件夹的批量移动,那么就可以不费力的将已完成工作移动到指定文件夹。然而搜索了很多实例,都没有可以参考的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
经过多交测试后成功。但在使用过程中发现,不能跨越两个本地磁盘,也不能自定义相同磁盘的不同文件夹。还请大家帮忙一起完善。
点击下载此附件