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