英文:
Moving oldest files first from source to destination
问题
我有超过2000个文件在一个源文件夹中,我使用以下代码来移动这些文件。这个过程之前一直运行正常,但是今天(两周后)出现了以下错误:
运行时错误 58:“文件已存在”
经过检查,源文件夹和目标文件夹中都没有这样的文件,所有文件名都是不同的。
即使源文件夹和目标文件夹都是空的,它仍然在Name FromPath & fileName As ToPath & fileName
这一行出现相同的错误。
Function OldestFile(strFold As String) As String
Dim FSO As Object, Folder As Object, File As Object, oldF As String
Dim lastFile As Date: lastFile = Now
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(strFold)
For Each File In Folder.Files
If File.DateCreated < lastFile Then
lastFile = File.DateCreated: oldF = File.Name
End If
Next
OldestFile = oldF
End Function
Sub MoveOldestFile()
Dim FromPath As String, ToPath As String, fileName As String, limit As Long
FromPath = "C:\Users\user\Desktop\Source\"
ToPath = "C:\Users\user\Desktop\Destination\"
limit = 20
filesmoved = 0
fileName = OldestFile(FromPath)
Do Until fileName = "" Or filesmoved = limit
If Dir(ToPath & fileName) = "" Then
Name FromPath & fileName As ToPath & fileName
filesmoved = filesmoved + 1
End If
fileName = OldestFile(FromPath)
Loop
End Sub
希望这可以帮助您解决问题。
英文:
I have more than 2000 files in a source which I was moving using the code below. The process was running but today (after two weeks) it gives
>Run Time Error 58" "File Already Exist"
Upon checking there is no such file which is available in source and destination folder and all files names are separate from each other.
Even if both source and destination folders are empty it is giving the same error at the line Name FromPath & fileName As ToPath & fileName
.
Function OldestFile(strFold As String) As String
Dim FSO As Object, Folder As Object, File As Object, oldF As String
Dim lastFile As Date: lastFile = Now
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(strFold)
For Each File In Folder.Files
If File.DateCreated < lastFile Then
lastFile = File.DateCreated: oldF = File.Name
End If
Next
OldestFile = oldF
End Function
Sub MoveOldestFile()
Dim FromPath As String, ToPath As String, fileName As String, limit As Long
FromPath = "C:\Users\user\Desktop\Source\"
ToPath = "C:\Users\user\Desktop\Destination\"
limit = 20
filesmoved = 0
fileName = OldestFile(FromPath)
Do Until fileName = "" Or filesmoved = limit
If Dir(ToPath & fileName) = "" Then
Name FromPath & fileName As ToPath & fileName
filesmoved = filesmoved + 1
End If
fileName = OldestFile(FromPath)
Loop
End Sub
答案1
得分: 0
我无法说我理解你的代码逻辑,因为最终它将移动 所有 文件,无论它们有多旧,那么将最旧的文件移动有什么作用呢?
不管怎样,你可以通过检查文件属性来跳过系统文件(例如 desktop.ini)来实现你的目标。
Function OldestFile(strFold As String) As String
Const ATTR_SYSTEM = 2
Dim FSO As Object, Folder As Object, File As Object, oldF As String
Dim lastFile As Date: lastFile = Now
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(strFold)
For Each File In Folder.Files
If (File.Attributes And ATTR_SYSTEM) = 0 And File.DateCreated < lastFile Then
lastFile = File.DateCreated: oldF = File.Name
End If
Next
OldestFile = oldF
End Function
你可以使用上面的代码来找到最旧的文件,同时跳过系统文件。
英文:
I cannot say that I understand the logic of your code as at the end it will move all files, no matter how old they are, so what do you achieve with the fact that you move the oldest file first?
Anyhow, what you could do is to skip system files (like desktop.ini) by checking the file attribute
Function OldestFile(strFold As String) As String
Const ATTR_SYSTEM = 2
Dim FSO As Object, Folder As Object, File As Object, oldF As String
Dim lastFile As Date: lastFile = Now
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(strFold)
For Each File In Folder.Files
If (File.Attributes And ATTR_SYSTEM) = 0 And File.DateCreated < lastFile Then
lastFile = File.DateCreated: oldF = File.Name
End If
Next
OldestFile = oldF
End Function
答案2
得分: 0
将以下行更改为:
If Dir(ToPath & fileName, 7) = "" Then
这一行未能检查只读、系统或隐藏文件。因此,您的代码尝试重命名现有的隐藏文件。
您可以尝试您的代码的这个变体,它在处理大目录时应具有更好的性能,因为它不会每次都遍历整个目录。
Function OldestFile(strFold As String) As Variant
Dim FSO As Object, Folder As Object, File As Object, oldF As String
Dim lastFile As Date: lastFile = Now
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(strFold)
Dim myarray As Variant
If Folder.Files.Count > 0 Then
ReDim myarray(Folder.Files.Count - 1)
ix = 0
For Each File In Folder.Files
myarray(ix) = Format(File.DateCreated, "YYYYMMDDHHmmSS") & File.Name
ix = ix + 1
Next
For i = LBound(myarray) To UBound(myarray) 'Sort according to date
For j = i + 1 To UBound(myarray)
If UCase(myarray(i)) > UCase(myarray(j)) Then
Temp = myarray(j)
myarray(j) = myarray(i)
myarray(i) = Temp
End If
Next j
Next i
End If
OldestFile = myarray
End Function
Sub MoveOldestFile()
Dim FromPath As String, ToPath As String, fileName As String, limit As Long
Dim fileArray As Variant
FromPath = "C:\Users\user\Desktop\Source\"
ToPath = "C:\Users\user\Desktop\Destination\"
limit = 20
filesmoved = 0
fileArray = OldestFile(FromPath)
If Not IsEmpty(fileArray) Then
ix = 0
Do Until ix > UBound(fileArray) Or filesmoved = limit
fileName = Mid(fileArray(ix), 15)
If Dir(ToPath & fileName, 7) = "" Then
Name FromPath & fileName As ToPath & fileName
filesmoved = filesmoved + 1
End If
ix = ix + 1
Loop
End If
End Sub
英文:
change the following line:
If Dir(ToPath & fileName) = "" Then
to
If Dir(ToPath & fileName, 7) = "" Then
That line is failing to check for read only, system or hidden files. So your code tries to rename an existing hidden file.
Yo may want to try this variant of your code which should have a better performance in big directories as it does not iterate over the whole directory each time
Function OldestFile(strFold As String) As Variant
Dim FSO As Object, Folder As Object, File As Object, oldF As String
Dim lastFile As Date: lastFile = Now
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(strFold)
Dim myarray As Variant
If Folder.Files.Count > 0 Then
ReDim myarray(Folder.Files.Count - 1)
ix = 0
For Each File In Folder.Files
myarray(ix) = Format(File.DateCreated, "YYYYMMDDHHmmSS") & File.Name
ix = ix + 1
Next
For i = LBound(myarray) To UBound(myarray) 'Sort according to date
For j = i + 1 To UBound(myarray)
If UCase(myarray(i)) > UCase(myarray(j)) Then
Temp = myarray(j)
myarray(j) = myarray(i)
myarray(i) = Temp
End If
Next j
Next i
End If
OldestFile = myarray
End Function
Sub MoveOldestFile()
Dim FromPath As String, ToPath As String, fileName As String, limit As Long
Dim fileArray As Variant
FromPath = "C:\Users\user\Desktop\Source\"
ToPath = "C:\Users\user\Desktop\Destination\"
limit = 20
filesmoved = 0
fileArray = OldestFile(FromPath)
If Not IsEmpty(fileArray) Then
ix = 0
Do Until ix > UBound(fileArray) Or filesmoved = limit
fileName = Mid(fileArray(ix), 15)
If Dir(ToPath & fileName, 7) = "" Then
Name FromPath & fileName As ToPath & fileName
filesmoved = filesmoved + 1
End If
ix = ix + 1
Loop
End If
End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论