2015/12/06

SimpleReplacedRename・・・

・・・って、一旦 VBScriptのソースだけ公開。


おきつね環境では かなり以前に組み、利用し続けているスクリプトなんだケド、唐突に公開してみる。
このスクリプトや そのショートカットに、フォルダやファイルをドロップして利用する。
尚、ファイルでは ドロップ出来る数に限りがある。
数百数千のファイルを一気に処理する場合は、フォルダをドロップして用いるよう構成している。

従って、意図的にフォルダ名の置換書き換えはサポートしていない。 その事に因んで "Simple"と銘打ってる。
最初の画面で ファイル名に含まれる "任意の文字列A" を指定、続く画面で、"置換したい文字列B" を指定して実行すると、 文字列Aがある対象のみ その箇所を、2番目に指定した文字列Bで置換したファイル名に変える それだけのスクリプト。
但し、簡易化の過程で 大幅に処理を省き、対象となるオブジェクト(ファイル)の名前を直接変える構造にした為、
アルファベットの大文字小文字の置換は "ファイル名が変わってない" と 判断されてエラー停止する。
因みに、最初の指定条件に "ファイル名に含まれる消したい文字列" を、 続く画面を "無入力" で 進めると、その文字列を含まないファイル名に書き換えられる。
◆ 肝心のスクリプトはコンなカンジ。
■ SimpleReplacedRename.vbs
'***** ↓↓↓ScriptTitle↓↓↓ ********************************************************* 'SimpleReplacedRename '- Created by LazwardFox - ' ' Update 20151206 023930 未使用関数を削除するなど 少し清書。 ' Update 20100110 1240 処理部を汎用関数化 ' Update 20100110 1233 フォルダドロップに対応 ' Update 20100110 1156 対象ファイル名全体から 一部を置換する簡易処理に ' Update 20100109 0909 対象ファイルのあるフォルダ名に ' Update 20090729 1613 フォルダ名処理に対応、拡張子指定でフォルダ処理は回避可 指定も可能に ' Update 20090504 0227 拡張子なしファイルを、フォルダと誤認しないよう処理を追記 ' Release 20090430 1843 ファイル名から動作を取得 / スクリプト名称変更 ' βRelease 20090430 1755 ' DevStart 20090424 2200 '***** ↓↓↓ ObjectDecralations ↓↓↓ ************************************************* Option Explicit Public My, Parameters, MySh, Fs Set My = WScript With My Set Parameters = .Arguments 'パラメーター取得 If Parameters.Count <= 0 Then 'パラメータなし起動の無効化 .Quit End If Set MySh = .CreateObject("WScript.Shell") Set Fs = .CreateObject("Scripting.FileSystemObject") 'ファイル制御 End With '***** ↓↓↓ Decralations ↓↓↓ ************************************************* Public ThisScript 'Public ThisScriptFull, ThisScript, Start 'Const vbWq = """" Dim vbWCrLf, vbTc vbWCrLf = vbCrLf & vbCrLf vbTc = vbTab & vbCrLf '***** ↓↓↓MainRoutine↓↓↓ ********************************************************* 'On Error Resume Next Dim strTarget, strReplace, Result, strResult ThisScript = Fs.GetBaseName(My.ScriptFullName) If Parameters.Count > 1 Then ' 多数ドロップ時のみ確認画面表示 fStart "RenameStart?" End If strTarget = InputBox("TargetStrings", ThisScript) ',bName) If strTarget = "" Then exQuit End If strReplace = InputBox("ReplacingStrings", ThisScript) If strReplace = "" Then '対象を消去 する為にこの処理は不可。 fStart "RenameStart?" End If Result = fReplace(Parameters, strTarget, strReplace, 0) ' ← 0 - 拡張子置換可能 'Result = fReplace(Parameters, strTarget, strReplace, 1) ' ← 1 - 拡張子保護 If TypeName(Result) = "String" Then strResult = Result Else If Result > 0 Then strResult = "Renamed - " & Result & "File" Else strResult = "TargetNotFound" End If End If MySh.Popup strResult & vbTab, 15, ThisScript,64 exQuit '***** ↓↓↓Functions↓↓↓ ********************************************************* '------------------------------------ ' fStart ' ' Update ' βRelease ' αRelease 20100110 1303 ' ' DevStart 20110110 0543 関数化 Function fStart(strMessage) Dim sResult sResult = 1 sResult = MySh.Popup(strMessage, 15, ThisScript, 33) If sResult = 2 Then exQuit Else fStart = sResult End IF End Function '------------------------------------ ' exQuit ' ' Update ' βRelease ' αRelease 20100110 1303 ' ' DevStart 20110110 0549 関数化 Sub exQuit() Set Fs = Nothing Set MySh = Nothing My.Quit End Sub '------------------------------------ ' fReplace ' 拡張子も置換対象に指定可能 ' Update ' βRelease ' αRelease 20100110 1303 拡張子分岐を再度追加。 ' 但し、ファイル種別分岐ではなく、拡張子置換/回避処理 ' DevStart 20100110 1240 関数化 Function fReplace(arTargets, strTarget, strReplace, ExitensionFlag) Dim Pc, Source, Extention, arSource, strFile, objSource, strName Pc = 0 If strTarget = "" Then fReplace = "ParameterError" & vbWCrLf & " 置換対象文字列が指定されていません。" Else For Each Source in arTargets Extention = Fs.GetExtensionName(Source) If Extention = "" Then Set arSource = Fs.GetFolder(Source).Files Else arSource = Array(Source) End If For Each strFile In arSource Set objSource = Fs.GetFile(strFile) With objSource If ExitensionFlag = 1 Then strName = Fs.GetBaseName(.Name) strName = Replace(strName, strTarget, strReplace) strName = strName & "." & Fs.GetExtensionName(.Name) Else strName = Replace(.Name, strTarget, strReplace) End If If .Name = strName Then Else .Name = strName Pc = Pc + 1 End If End With Set objSource = Nothing Next Next fReplace = Pc End If End Function

0 件のコメント:

コメントを投稿