－－－－－－－－－－ Update 200905040237
スクリプト中に１処理２行を追加。
パラメータ中の、フォルダと、拡張子なしファイルの識別を行う重要な行。
手抜きで入れてなかった(悪) 元々暫定版だしw
アーカイブも、ココのソースも、この版に更新済み。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－
先のログで触れた、SD14のファイル管理向けReplacedRenameスクリプト、
あんまりな造りだったので、公開しない予定だったが、ちょっとした工夫を加えて汎用化したので、うpしてみた。
アーカイブはコチラ▼
▲ を、右クリックしてファイルとして保存してください。
ただ単純にファイル名の文字列置換するだけだと なんか芸がないし、使い勝手が悪い。
あと、置換後の名称と同名のファイルが既存の場合は、バックアップ取らせたいし、
対象ファイルがない場合は処理したくないし･･･ とか云ってると、同じ処理の繰り返しも多くなる。
元々のモノも、そのヘンは考慮した造りだったのだが、記述自体は間に合わせ感たっぷりの、
この上なくゴチャゴチャなモノだった。
また、置換前後の文字列と対象拡張子指定を、スクリプト内に直記述していた為、全く他への流用も利かなかった･･･
んで、そのままでは、今後使い辛いってのもあったので、
ファイル名変更部や、ファイルの名称に日時を付けでバックアップする処理を分離し、
スクリプト自身のファイル名を条件パラメータとして利用する構造に変更するコトで、
現在のようなスマートな状態になった。
使い方も簡単で、このスクリプト自体のファイル名を･･･
書式)
{Before}_{After}_{拡張子}_..._{拡張子}.vbe
|
記述例)
のように変更済ませば、スクリプト本体か そのショートカットに、対象のファイルかフォルダをドロップするだけでいい。
複数フォルダ／ファイルドロップに対応、フォルダは第１階層分のみ対応、ソレより深い階層のファイルは処理しない。
あと、蛇足だが、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 少ない 欠点 ファイル 名称 まとめて置換 日付 バックアップ＞
0 件のコメント:
コメントを投稿
注: コメントを投稿できるのは、このブログのメンバーだけです。