VBScriptで再帰的にフォルダをたどり条件に合致するファイルだけをコピーするスクリプト

火曜日 , 9, 9月 2014 Leave a comment

VBScriptで再帰的にフォルダをたどり、条件に合致するファイルを階層構造を保ちながらコピーするスクリプトです。
条件はIsTargetのあたりをいじれば直せます。

実行はWindowsのコマンドプロンプトを開き、

CScript FileCopy.VBS

みたいな感じで実行します。


    Set FSO = CreateObject("Scripting.FileSystemObject")
    FileCopy FSO, "C:\Src", "C:\Dest"
    Set FSO = Nothing
	
	WScript.Quit 0
	
'========================================================================
' コピーの条件
' - 引数 -
'	ObjFile	対象ファイル
' - 返り値 -
'	True: 対象 / False: 対象外
'========================================================================
Function IsTarget(ObjFile)
	If ObjFile.DateLastModified  >= CDate("2014/07/10") Then
        IsTarget = True
    Else
        IsTarget = False
    End If
End Function

'============================================================================
' - 機能 -
'	指定フォルダ以下の条件に合致するファイルをコピー
' - 引数 -
'	FSO		FileSystemObject
'	StrSrcPath	コピー元パス
'	StrDestPath	コピー先パス
'============================================================================
Sub FileCopy(FSO, StrSrcPath, StrDestPath)
Dim ObjFolder   
Dim ObjFile
Dim ObjSubFolder

    Set ObjFolder = FSO.GetFolder(StrSrcPath)
    For Each ObjFile in ObjFolder.Files
        
        ' If ObjFile.DateLastModified  >= DatBase Then
        If IsTarget(ObjFile) Then

            If Not FSO.FolderExists(StrDestPath) Then
                Wscript.Echo StrDestPath
                CreateDirectory FSO, StrDestPath
            End If

            Wscript.Echo "  " & ObjFile.Path
            FSO.CopyFile ObjFile.Path, StrDestPath & "\" & ObjFile.Name
        End If
    Next

    For Each ObjSubFolder in ObjFolder.SubFolders
        FileCopy FSO, ObjSubFolder.Path, StrDestPath & "\" & ObjSubFolder.Name
    Next
	
End Sub 

'============================================================================
' - 機能 -
'	再帰的なディレクトリ作成
' - 引数 -
'	FSO		FileSystemObject
'	StrPath	作成ディレクトリ
'============================================================================
Sub CreateDirectory(FSO, StrPath)
Dim StrParentFolder

	StrParentFolder = FSO.GetParentFolderName(StrPath)

	If Not FSO.FolderExists(StrParentFolder) Then
		CreateDirectory FSO, StrParentFolder
	End If
	
	If Not FSO.FolderExists(StrPath) Then
		FSO.CreateFolder StrPath
	End If
    
End Sub
Tags:,

Please give us your valuable comment

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください