VBScriptで、日付付きFileBackup･･･

FileBackupper.vbs と .vbe を、暫定で今使ってるままをうpしました。
ファイル／フォルダ右クリックのコンテキストメニューに、
[バックアップ作成]を追加する機能はまだ付いていない版です。

デキルコトは、対象ファイル／フォルダの名称を、
"[元FileName] yyyymmdd hhnnss.[拡張子]" に 変え、コピーを取るだけ。

実働のブツなので使えますが、未使用関数が載ったままになってたりと、
効率が悪い部分が残っています。 

改訂版も後日うpするので、コノ分は、あくまで、参考までに･･･

   FileBackupper.zip    
▲ を、右クリックしてファイルとして保存してください。

使い方は至って簡単、ファイルやフォルダをドラッグするだけ。
ショートカットでの利用も可。

    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
        'File/Folder Backuper     
        '- Created by LazwardFox -     
              
        'TargetFile Autobackup     
        'ドラッグ(パラメータ指定)されたファイルを、     
        '名称に年月日時分秒を付けて同じフォルダ内にコピーをとる     
         
        'Update 20090209 2035      
        'Release 20060712 1736 フォルダのコピーにも対応させ、正式発行     
        'DevStart 20060413 1026     
          
    '***** ↓↓↓ ObjectDecralations ↓↓↓ *************************************************     
         
        Set Parameters = WScript.Arguments 'パラメーター取得     
        If Parameters.Count <= 0 Then     
            Wscript.Quit     
        End If     
         
        Set WSHShell = WScript.CreateObject("WScript.Shell")     
        Set Fs = WScript.CreateObject("Scripting.FileSystemObject") 'ファイル制御     
         
    '***** ↓↓↓ Decralations ↓↓↓ *************************************************     
         
        Public Target, Source, ThisScript      
        Public Extention, NameOnly, ProcessFolder     
        Dim SourceFolder, SourceFiles, SourceFile, RNameOnly     
        Public Result     
             
        Dim BackupFile, strFiles, strResult, SettedPF     
         
    '***** ↓↓↓MainRoutine↓↓↓ *********************************************************     
        ThisScriptFull = Wscript.ScriptFullName     
        ThisScript = Fs.GetBaseName(ThisScriptFull)     
         
        For Each SourceFile in Parameters     
            BackupFile = BackupName(SourceFile )     
            If Extention = "" Then     
                Fs.CopyFolder SourceFile, BackupFile     
                Control = "FolderCopy"     
            Else     
                Fs.CopyFile SourceFile, BackupFile     
                Control = "FileCopy"     
            End If     
            'ResultMake '▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼     
            If strResult = "" then     
                strResult = vbCrlf & "● " & ProcessFolder & "　　" & vbCrlf     
                SettedPF = ProcessFolder     
            Else     
                If SettedPF = ProcessFolder Then     
                Else     
                    SettedPF = ProcessFolder     
                    strResult = strResult & vbCrlf & vbCrlf & "● " & ProcessFolder & "　　" & vbCrlf     
                End If     
            End If     
            strResult =  strResult & vbCrlf & "　　" & NameOnly & "　　" & vbCrlf & vbTab & "   ▼　　" & vbCrlf & "　　" & vbTab & RNameOnly & "　　"  & vbCrlf     
            '▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲     
        Next     
        Msgbox strResult,,ThisScript & " " & Control     
        Set Fs = Nothing     
        Set WSHShell = Nothing     
             
        Wscript.Quit     
             
    '***** ↓↓↓Functions↓↓↓ *********************************************************     
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'BackupName - バックアップ後の名称を構築     
        '- Created by LazwardFox -     
             
            'フルパスを返す     
            '結果表示用変数に値を代入     
            'NameOnly  － ファイル名     
            'RNameOnly － 変換後ファイル名     
            'ファイル／フォルダの識別     
            'Extention － 値が空白で返されたら 対象はフォルダ     
                 
            '注)完全な独立関数にはなっていない。     
         
            'Release 20060712 1743     
                 
        Public Function BackupName(SourceName )     
            Dim FoldersFiles, FoldersCount, FileNamesEx, BlockCount, BackupString     
            FileNamesEx = Split(SourceName,".")     
            BlockCount = UBound(FileNamesEx)     
            If BlockCount > 0 Then 'File     
                Extention = "." & FileNamesEx(BlockCount)     
            Else 'Folder     
                Extention = ""      
            End If     
            BackupString = " " & iDT(""," ","",0) & Extention     
                 
            FoldersFiles = Split(SourceName,"\")     
            FoldersCount = UBound(FoldersFiles)     
            If Extention = "" Then 'Folder     
                NameOnly = SourceName     
                ProcessFolder = SourceName     
                RNameOnly = SourceName & BackupString     
                BackupName = RNameOnly     
            Else 'File     
                NameOnly = FoldersFiles(FoldersCount)     
                ProcessFolder = Replace(SourceName, NameOnly, "")     
                BackupName = Replace(SourceName, Extention, BackupString)     
                RNameOnly = Replace(BackupName, ProcessFolder, "")     
            End If     
        End Function     
             
        Public Function FolderSelector()     
            OnFolder = UpdatesCopy()     
            For Each SourceFile In SourceFolder.SubFolders     
                Set SourceFolder = SourceFile     
                OnFolder = UpdatesCopy()     
                '▼ Tester ▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼     
                msgbox "2 - サブフォルダ数 - " & OnFolder,,ThisScript     
                '▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲     
                If OnFolder = 0 Then     
                Else     
                    Set LSourceFolder = SourceFolder     
                    For Each tSourceFolder In LSourceFolder.SubFolders     
                        Set SourceFolder = tSourceFolder     
                        FolderSelector()     
                        Set tSourceFolder = SourceFolder     
                    Next     
                    Set SourceFolder = LSourceFolder     
                End If     
            Next      
        End Function     
             
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'UpdatesCopy     
        '- Created by LazwardFox -     
         
        Public Function UpdatesCopy()     
            '▼ Tester ▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼     
            If SourceFolder.Files.Count = 0 Then     
                If SourceFolder.Name="" Then     
                    FolderName = "Root"     
                Else     
                    FolderName = SourceFolder.Name     
                End If     
                msgbox "3 - " & FolderName & vbCrLf & "対象フォルダにファイルが無い",,"UpdatesCopy"     
            Else     
                tResult = SourceFolder.name & " - "  & SourceFolder.Files.Count & vbCrLf     
            End If     
            '▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲     
                 
            For Each SourceFile In SourceFolder.Files     
                tResult = tResult & SourceFile.Path & vbcrlf      
            Next      
                 
            '▼ Tester ▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼     
            tResult = Replace(tResult &    "_", vbcrlf & "_","")     
            If Not tResult = "_" Then     
                msgbox "4 - ファイル一覧" & vbCrLf & tResult,,ThisScript     
            End If     
            '▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲     
                 
            UpdatesCopy = SourceFolder.SubFolders.Count     
        End Function     
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'iDT - 日時文字列 ないし 日/時配列取得 for VBScript     
        '- Created by LazwardFox -     
         
             
            ' Update 20090228 0458 変数宣言変更     
            ' Update 20090223 0959 時刻桁処理変更     
            ' Update 20090223 0253 Len記述忘れ修正     
            ' Update 20090223 0135 変数宣言忘れ修正     
            ' Update 20090210 0218     
            ' Update 20090210 0115     
            ' Release 20090209 2035     
         
            '    iDT (     
            '       dSplitter - DateSplitString             (Normal - "/")     
            '      ,dtSeparater - Date/Time SepaleteString  (Normal - " ")     
            '      ,tSplitter - TimeSplitString             (Normal - ":")     
            '      ,Control - 配列化 0 or 1                 (Default - 1)     
            '      )     
         
        Public Function iDT(dSplitter,dtSeparater,tSplitter,Control)     
            Dim nX, nD, nS, strHMS, sResult 'Update 20090228 0458     
            nX = Now()     
            nD = FormatDateTime(Date(),0)     
            nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2)     'Update 20090223 0951     
            strHMS = FormatDateTime(nX,4) & nS                      'Update 20090223 0951     
            If tSplitter = ":" Then     
            Else     
                strHMS = Replace(strHMS,":",tSplitter)     
            End If     
            sResult = Cstr(Replace(nD,"/",dSplitter)) & "*" & strHMS     
            If Control = 1 Then     
                iDT = Split(sResult,"*")     
            Else     
                iDT = Replace(sResult,"*",dtSeparater)                 
            End If     
        End Function     


しかし、リリース2006年かぁ･･･(遠い目) ファイル文字列処理に初々しさがあるよねw

ちなみに、もっと程度の低い版なら、2004年にはあったw
更に前だとWinBatch版、もっと前はBatファイルだったなぁ･･･(更に遠い目)

もう、過去のHDDクラッシュで、ソース紛失してるケド^_^;
＜そのまま使えるVBscript 日付 添付 バックアップ ファイル フォルダ＞