---------- Update 200905040237
スクリプト中に1処理2行を追加。
パラメータ中の、フォルダと、拡張子なしファイルの識別を行う重要な行。
手抜きで入れてなかった(悪) 元々暫定版だしw
アーカイブも、ココのソースも、この版に更新済み。
----------------------------
先のログで触れた、SD14のファイル管理向けReplacedRenameスクリプト、
あんまりな造りだったので、公開しない予定だったが、ちょっとした工夫を加えて汎用化したので、うpしてみた。
アーカイブはコチラ▼
▲ を、右クリックしてファイルとして保存してください。
ただ単純にファイル名の文字列置換するだけだと なんか芸がないし、使い勝手が悪い。
あと、置換後の名称と同名のファイルが既存の場合は、バックアップ取らせたいし、
対象ファイルがない場合は処理したくないし・・・ とか云ってると、同じ処理の繰り返しも多くなる。
元々のモノも、そのヘンは考慮した造りだったのだが、記述自体は間に合わせ感たっぷりの、
この上なくゴチャゴチャなモノだった。
また、置換前後の文字列と対象拡張子指定を、スクリプト内に直記述していた為、全く他への流用も利かなかった・・・
んで、そのままでは、今後使い辛いってのもあったので、
ファイル名変更部や、ファイルの名称に日時を付けでバックアップする処理を分離し、
スクリプト自身のファイル名を条件パラメータとして利用する構造に変更するコトで、
現在のようなスマートな状態になった。
使い方も簡単で、このスクリプト自体のファイル名を・・・
書式)
{Before}_{After}_{拡張子}_..._{拡張子}.vbe
|
記述例)
のように変更済ませば、スクリプト本体か そのショートカットに、対象のファイルかフォルダをドロップするだけでいい。
複数フォルダ/ファイルドロップに対応、フォルダは第1階層分のみ対応、ソレより深い階層のファイルは処理しない。
あと、蛇足だが、FileSystemObjectのFolderオブジェクトは中々のクセ者だったコトを付け加えておこう。
よく使っていた対象なので、全く油断したというのがホントのトコで、意外な伏兵だった。
フォルダ内を検索し、一部のファイルに対して処理を行う程度ならともかく、
ここで紹介しているような、フォルダ内のファイル名を順繰りに全て処理する体のスクリプトの場合、
オブジェクトを直接利用し、単純にForEach-Nextで処理を組むと、ファイル名変更済みファイルを再度、
条件に基づいて処理してしまう。
実のトコロ、ココで紹介しているスクリプトの基となった暫定版がそうだったのだよ(´ヘ`;)
しかもコレが厄介で、問題の対象は、全てが二重処理されている訳でもなく、規則性もない・・・
原因については、機器のスペックの向上なども大きいと思われるが、おそらくは仕様だろうw
症状を診るに、序盤に名称変更したファイルの幾つかが、本来最後である筈のファイルの後に続いて、
既存ファイルとして呼び出されてしまっているようだ(´ヘ`;)
この挙動から判断するに、普通の関数や配列変数を使うつもりで、
FileSystemObjectのFolderオブジェクトを利用するのは、極めて避けるべき行為なのかもしれない。
・・・仕方がないので、置換(名称変更)処理に先んじて、
フォルダオブジェクトから全てのファイル名を文字列として取り出し、
それらで構成された配列変数を作成するコトで対策とするコトにした。
コレも、よく使う処理なので別途関数にした、ソレが、Function F2a・・・
簡単な処理だが、ある と ない とではエラくちがう(^_^;
オマケだか、上記誤処理をデバッグする過程でデキた、云わば副産物の、
動作中の対象文字列の収集と表示を行う関数 も同梱してあったりするw
で、ソースはコチラ▼
Public My, Parameters, MySh, Fs Set My = WScript Set Parameters = My.Arguments If Parameters.Count <= 0 Then My.Quit End If Set MySh = My.CreateObject("WScript.Shell") Set Fs = My.CreateObject("Scripting.FileSystemObject") Public ThisScriptFull, ThisScript, Start Const vbWq = """" Dim vbWCrLf, vbTc vbWCrLf = vbCrLf & vbCrLf vbTc = vbTab & vbCrLf Dim Source, Extention Dim cParameters, pDepth, tExt ThisScriptFull = My.ScriptFullName ThisScript = Fs.GetBaseName(ThisScriptFull) cParameters = Split(ThisScript,"_") pDepth = Ubound(cParameters) If pDepth >= 2 Then If pDepth > 2 Then For Pc = 2 to pDepth If tExt = "" Then tExt = cParameters(Pc) Else tExt = tExt & "," & cParameters(Pc) End If Next End If Else My.Quit End If If Parameters.Count > 1 Then Start = MySh.Popup("RenameStart?",15,ThisScript,33) End If If Start = -1 Or Start = 2 Then Else For Each Source in Parameters Extention = Lcase(Fs.GetExtensionName(Source)) If Extention = "" Then If Fs.FolderExists(strParameters) Then Dim arFiles, SourceFile arFiles = F2a(Source) For Each SourceFile in arFiles fReplace SourceFile, cParameters(0), cParameters(1), tExt Next End If Else fReplace Source, cParameters(0), cParameters(1), tExt End If Next MySh.Popup "Renamed",15,ThisScript,33 End If Set Fs = Nothing Set MySh = Nothing My.Quit Function F2a(strTarget) Dim objFolder, arF2a(), Pc Pc = 0 Set objFolder = Fs.GetFolder(strTarget) For Each strTarget in objFolder.Files Redim Preserve arF2a(Pc) arF2a(Pc) = strTarget Pc = Pc + 1 Next Set objFolder = Nothing Pc = 0 F2a = arF2a End Function Function fReplace(strTarget, strSource, strReplace, strExts) Dim Replaced, objTarget, RootPath, ReplacedFull RootPath = Fs.GetParentFolderName(strTarget) Replaced = Replace(Fs.GetFileName(strTarget),strSource,strReplace) ReplacedFull = Fs.BuildPath(RootPath, Replaced) dRename ReplacedFull If strExts = "" Then Else Dim arExts, tExt arExts = Split(strExts,",") lExt = LCase(Fs.GetExtensionName(strTarget)) For Each tExt in arExts If tExt = lExt Then Exit For End If tExt = "" Next If tExt = "" Then Exit Function End If End If iRename strTarget, Replaced End Function Function iRename(Target, strRename) Dim objTarget If Fs.FileExists(Target) Then Set objTarget = Fs.GetFile(Target) objTarget.Name = strRename Set objTarget = Nothing End IF End Function Function dRename(Target) Dim dExt, Deted If Fs.FileExists(Target) Then dExt = "." & LCase(Fs.GetExtensionName(Target)) Deted = Replace(Fs.GetFileName(Target),dExt," " & iDT(""," ","",0) & dExt) iRename Target, Dated End IF End Function Public Function iDT(dSplitter,dtSeparater,tSplitter,Control) Dim nX, nD, nS, strHMS, sResult nX = Now() nD = FormatDateTime(Date(),0) nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2) strHMS = FormatDateTime(nX,4) & nS 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 Public strTests, tPc Function iTest(strTarget, Control) If Control > 0 Then If tPc > Control Then tPc = 0 strTests = strTests & "," & strTarget Else If strTests = "" Then strTests = strTarget Else strTests = strTests & vbTc & strTarget End If End If tPc = tPc + 1 Else Dim arTarget, vTarget arTarget = Split(strTests,",") For Each vTarget In arTarget Msgbox vTarget,,strTarget Next End If End Function
|
<そのまま使える SIGMA SD14 SDIM####.X3F カウント 9999 少ない 欠点 ファイル 名称 まとめて置換 日付 バックアップ>