从源到目的地首先移动最旧的文件

huangapple go评论64阅读模式
英文:

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 &amp; fileName As ToPath &amp; 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(&quot;Scripting.FileSystemObject&quot;)
    Set Folder = FSO.GetFolder(strFold)
    For Each File In Folder.Files
        If File.DateCreated &lt; 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 = &quot;C:\Users\user\Desktop\Source\&quot;
    ToPath = &quot;C:\Users\user\Desktop\Destination\&quot;
    limit = 20
    filesmoved = 0
    fileName = OldestFile(FromPath)
    Do Until fileName = &quot;&quot; Or filesmoved = limit
        If Dir(ToPath &amp; fileName) = &quot;&quot; Then
            Name FromPath &amp; fileName As ToPath &amp; 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(&quot;Scripting.FileSystemObject&quot;)
    Set Folder = FSO.GetFolder(strFold)
    For Each File In Folder.Files
        If (File.Attributes And ATTR_SYSTEM) = 0 And File.DateCreated &lt; 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 &amp; fileName) = &quot;&quot; Then

to

If Dir(ToPath &amp; fileName, 7) = &quot;&quot; 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(&quot;Scripting.FileSystemObject&quot;)
    Set Folder = FSO.GetFolder(strFold)
    Dim myarray As Variant
    If Folder.Files.Count &gt; 0 Then
        ReDim myarray(Folder.Files.Count - 1)
        ix = 0
        For Each File In Folder.Files
            myarray(ix) = Format(File.DateCreated, &quot;YYYYMMDDHHmmSS&quot;) &amp; File.Name
            ix = ix + 1
        Next
        For i = LBound(myarray) To UBound(myarray) &#39;Sort according to date
            For j = i + 1 To UBound(myarray)
                If UCase(myarray(i)) &gt; 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 = &quot;C:\Users\user\Desktop\Source\&quot;
    ToPath = &quot;C:\Users\user\Desktop\Destination\&quot;
    limit = 20
    filesmoved = 0
    fileArray = OldestFile(FromPath)
    If Not IsEmpty(fileArray) Then
        ix = 0
        Do Until ix &gt; UBound(fileArray) Or filesmoved = limit
            fileName = Mid(fileArray(ix), 15)
            If Dir(ToPath &amp; fileName, 7) = &quot;&quot; Then
                Name FromPath &amp; fileName As ToPath &amp; fileName
                filesmoved = filesmoved + 1
            End If
            ix = ix + 1
        Loop
    End If
End Sub

huangapple
  • 本文由 发表于 2023年2月23日 22:28:10
  • 转载请务必保留本文链接:https://go.coder-hub.com/75546170.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定