我使用下面的代码来引用具有完整路径信息的表,以将文件从一个位置移动(或复制)到另一个位置。然而,它并没有移动任何东西,而是根据我的 Debug.Print 消息完成(Move Complete 2/22/2021 1:22:41 PM)。对我所缺少的有什么想法吗?
此外,我想构建文件位于源中的文件夹/子文件夹结构...但不知道如何实现这一点...以及如何执行此操作的指针?
Sub copy_files_from_table()
Dim FSO As Object
Dim source As String
Dim destination As String
Dim SQL As String
Dim RS As DAO.Recordset
Dim db As DAO.Database
SQL = "select * from file_test"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set db = CurrentDb
Set RS = db.OpenRecordset(SQL)
source = RS!LocalFile
destination = "C:\Temp\Test"
While Not RS.EOF
If Dir(source, vbDirectory) <> "" Then
objFSO.CopyFolder source, destination:=destination '
Debug.Print "Move Folder Command Complete From: " & destination
Else
End If
RS.MoveNext
Wend
Debug.Print "Move Complete " & Now()
End Sub
感谢提供的任何帮助。
到目前为止,我已经获得了以下代码来处理文件路径<259; however, anything longer is causing the code to error. Since I'm pretty green on coding:) any suggestions how I can get around the long file path names?
Sub CopyFilesFromTable2()
On Error GoTo ErrorHandler
Dim source As String
Dim destination As String
Dim FSO As New FileSystemObject
Dim SQL As String
Dim RS As DAO.Recordset
Dim db As DAO.Database
'Test Table
SQL = "select * from file_test"
'Prod Table
'SQL = "select * from file"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set db = CurrentDb
Set RS = db.OpenRecordset(SQL)
source = RS!LocalFile
File = VBA.FileSystem.Dir(source)
destination = "D:\Temp\Test\"
With RS
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
FSO.CopyFile RS!LocalFile, destination
.MoveNext
Wend
End If
.Close
End With
ExitSub:
Set RS = Nothing
'set to nothing
MsgBox "Done!"
Exit Sub
ErrorHandler:
MsgBox Err, vbCritical
Resume ExitSub
End Sub
Windows 显然对其处理的路径名有 260 个字符的限制。然而,可以翻转注册表标志以将其更改为超过 32K 字符!以下是如何更改它的说明:
https://youtu.be/JIBsJx7U0Xw?si=aJ9xLqqTLBbj1XGZ
但请注意,尝试将文件复制或移动到 OneDrive 等其他系统时,长路径名可能会致命。所以要注意这一点。