0

VBScripting で以下のタスクを実行する必要がある場所で問題が発生しました。助けてくれてありがとう。

あるフォルダーから 2 番目に変更された最新のファイルを別の場所にコピーしたいと考えています。

例: ソース フォルダ "Final" には、多くのサブフォルダが含まれます。スクリプトを実行した後、「Final」のすべてのサブフォルダーで 2 番目に最新の変更されたファイルを確認し、同じファイルを宛先フォルダーにコピーする必要があります。

4

1 に答える 1

0

@user、これがあなたが探している機能だと思います。私はであなたの問題の核心に取り組みましたSub Find()。バグがないことは保証されておらず、例外処理はさらに改善されると確信しています。

ヒント：Microsoftの信頼できるWSHリファレンスをWindowsヘルプファイルとしてダウンロードする方法については、この回答を参照してください。

Option Explicit

Dim oFF : Set oFF = New FileFinder
oFF.RootFolder = "C:\Source\Folder"  ' absolute or relative path
oFF.DestinationFolder = "C:\Copy\Folder\" ' must end with backslash

On Error Resume Next

'
' Find the newest and second-newest files.
'
oFF.Find

If Err Then
    WScript.Echo "Find error: " & Err.Description
    WScript.Quit(1)
Else
    WScript.Echo "Newest file: " & oFF.NewestFilePath
    WScript.Echo "Second-newest file: " & oFF.SecondNewestFilePath
End If

'
' Copy the second-newest file to the destination folder.
'
oFF.CopySecondNewestFileToDestination

If Err Then
    WScript.Echo "Copy error: " & Err.Description
    WScript.Quit(1)
Else
    WScript.Echo "'" & oFF.SecondNewestFilePath _
           & "' was copied to folder '" & oFF.DestinationFolder & "'."
End If

Set oFF = Nothing

' ============================================================

Class FileFinder

' Public RootFolder
Public NewestFilePath
Public NewestFileDate
Public SecondNewestFilePath
Public SecondNewestFileDate

Private mFso
Private mRootFolder
Private mDestinationFolder

Private Sub Class_Initialize()
    Set mFso = CreateObject("Scripting.FileSystemObject")
    Me.SecondNewestFilePath = ""
    Me.SecondNewestFileDate = CDate("1970/01/01")
    Me.NewestFilePath = ""
    Me.NewestFileDate = DateAdd("s", 1, Me.SecondNewestFileDate)
End Sub

Private Sub Class_Terminate()
    Set mFso = Nothing
End Sub

Public Property Let RootFolder(sValue)
    If Not mFso.FolderExists(sValue) Then
        Err.Raise vbObjectError + 1, "", _
           "Root folder '" & sValue & "' does not exist."
    End If

    mRootFolder = sValue
End Property

Public Property Get RootFolder()
    RootFolder = mRootFolder
End Property

Public Property Let DestinationFolder(sValue)
    If Not (Right(sValue, 1) = "\") Then
        Err.Raise vbObjectError + 1, "", _
           "Destination folder '" & sValue & "' must end with a backslash."
    End If

    If Not mFso.FolderExists(sValue) Then
        Err.Raise vbObjectError + 1, "", _
           "Destination folder '" & sValue & "' does not exist."
    End If

    mDestinationFolder = sValue
End Property

Public Property Get DestinationFolder()
    DestinationFolder = mDestinationFolder
End Property

Public Sub Find()
    Dim oFolder : Set oFolder = mFso.GetFolder(RootFolder)
    Dim oSubFolder, oFile

    For Each oSubFolder In oFolder.SubFolders
        For Each oFile In oSubFolder.Files
            '
            ' File is newer than newest file.
            '
            If DateDiff("s", NewestFileDate, _
                        oFile.DateLastModified) > 0 Then
                SecondNewestFilePath = NewestFilePath
                SecondNewestFileDate = NewestFileDate
                NewestFilePath = oFile.Path
                NewestFileDate = oFile.DateLastModified

            '
            ' File is newer than second-newest file.
            '
            ElseIf DateDiff("s", SecondNewestFileDate, _
                            oFile.DateLastModified) > 0 Then
                SecondNewestFilePath = oFile.Path
                SecondNewestFileDate = oFile.DateLastModified
            End If
        Next
    Next
End Sub

Public Sub CopySecondNewestFileToDestination()
    mFso.CopyFile SecondNewestFilePath, DestinationFolder
End Sub

End Class
于 2012-08-18T02:52:47.873 に答える