'//////////////////////////////////////////////////////////
'//
'//     コマンドライン引数で指定されたファイルを
'//         参照ボックスによって選択されたフォルダに
'//         コピーする（複数ファイルも指定可能）
'//         同名ファイルにつては、コピー元の日付が新しければ、
'//         上書きされる
Option Explicit
Dim args
Dim objShell, objFo, objFS
Dim strPath
Dim res

'//コマンドライン引数があるか調べる
'//     コマンドライン引数が渡されていなければ終了
Set args = Wscript.Arguments
If args.Count = 0 Then
    MsgBox "ファイルが指定されていません。",48
    WScript.Quit
End If

res = MsgBox("ファイルをコピーします。" & vbCr &_
    "同名ファイルがコピー先のフォルダにある場合、" & vbCr &_
    "コピー元の日付が新しけらば上書きされます。" & vbCr & vbCr &_
    "コピーを開始しますか？",33,"ファイルのコピー")
If res = 2 Then
    WScript.Quit
End If

'//コピー先のフォルダを選択
Set objShell = WScript.CreateObject("Shell.Application")
Set objFo = objShell.BrowseForFolder(0,_
    "コピー先のフォルダを選択して下さい",&h11)
If (objFo Is Nothing) Then
    WScript.Quit
End If
strPath = objFo.Items.Item.Path

'//各ファイルに対してコピー処理を行う
Dim myItem
Dim i
Set objFS = CreateObject("Scripting.FileSystemObject")
i = 0
For Each myItem in args

    '//ファイルが存在するか調べる
    If objFS.FileExists(myItem) Then
        Call CopyPr(myItem)     '//コピー処理
    Else
        MsgBox myItem & " が有りません",48
    End If

Next

'//終了のメッセージ
MsgBox i & " 個のファイルをコピーしました。",64,_
    "ファイルのコピー"


'//////////////////////////////////////
'//コピー処理
Sub CopyPr(strFile)

    Dim objFrom, objTo
    '//コピーするファイルがコピー先のフォルダに存在し
    '//     コピー先の日付の方が新しければコピーしない
    If objFS.FileExists(strPath & "\" &_
            objFS.GetFileName(strFile)) Then
        Set objFrom = objFS.GetFile(strFile)
        Set objTo = objFS.GetFile(strPath & "\" &_
            objFS.GetFileName(strFile))
        If objFrom.DateLastModified <= objTo.DateLastModified Then
            Exit Sub
        End If
    End If
    
    '//ファイルをコピー
    objFS.CopyFile strFile,strPath & "\"
    i = i + 1
    
End Sub