こういうリネーマー探しています

質問

リネーマーソフトでこういうのないでしょうか。
・ファイルだけでなく、フォルダ名もリネームできる。
・一覧になった文字列を利用して(コピペなど)新しい名前にできる。
私が探した範囲のソフトはフォルダ名を変えられるのは見つかったのですが、一覧のファイル名、フォルダ名の一部をコピペできないものでした。
ご存知の方よろしくお願いします。

回答No.2

misatoanna · ベストアンサー

こんな感じでしょうか。

1.一行目をタイトル行にし、項目名を入力しましょう。
　　A1＝親フォルダパス、B1＝サブフォルダ名、C1＝ファイル名、
　　D1＝指定Flag(1)、E1＝処理結果
2.A2には親フォルダのパス名を入力してください。
3.ここで、マクロ(DirListUp)を実行すると、二行目以下のＢ：Ｃ列に
　フォルダの中身が表示されます。
4.新フォルダ名にしたいファイル名の右(Ｄ列)に 1 を入力します。
　・Ｃ列からのコピペよりラクですね。
5.マクロ(ChgDirName)を実行します。
'------------------------------------
Sub DirListUp()
　Dim FPath, SubFol, Fol, RW, TargetFile, FNum
　Range("B2:E100").Clear
　FPath = Range("A2").Value
　If FPath <> "" Then
　　Set SubFol = CreateObject("Scripting.FileSystemObject") _
　　　　　　　　　　.GetFolder(FPath).SubFolders
　　RW = 2
　　For Each Fol In SubFol
　　　Range("B" & RW) = Fol.Name
　　　FNum = 0
　　　TargetFile = Dir$(FPath & "\" & Fol.Name & "\*.*")
　　　Do While TargetFile <> ""
　　　　FNum = FNum + 1
　　　　Cells(RW + FNum - 1, 3).FormulaR1C1 = TargetFile
　　　　TargetFile = Dir$
　　　Loop
　　　RW = RW + FNum
　　Next
　End If
End Sub
'
Sub ChgDirName()
　Dim i, FDir, FPath1, FPath2
　FDir = Cells(2, 1)
　i = 2
　Do While Cells(i, 3) <> ""
　　If Cells(i, 2) <> "" Then FPath1 = FDir & "\" & Cells(i, 2)
　　If Cells(i, 4) = 1 Then
　　　FPath2 = FDir & "\" & Left(Cells(i, 3), InStr(Cells(i, 3), ".") - 1)
　　　Name FPath1 As FPath2
　　　Cells(i, 5) = "この名前に変更しました"
　　End If
　　i = i + 1
　Loop
End Sub

お礼

なんというか・・・お礼のいいようがありません。
パーフェクトで、自分の思っていた使い方以上の
ことができて本当に感謝しています。
ありがとうございました。×∞

回答No.1

misatoanna

Excelのマクロで処理するのはいかがでしょう。

1.セルA1に「名前を変更したいフォルダ群がある親フォルダ」のフルパ
　スを入力します。（例）C:\MyDoc\Toriaezu
2.次のマクロを実行します。
　　Sub DirListUp()
　　　Dim FPath, SubFol, Fol, RW
　　　FPath = Range("A1").Value
　　　If FPath <> "" Then
　　　　Set SubFol = CreateObject("Scripting.FileSystemObject") _
　　　　　　　　　　　.GetFolder(FPath).SubFolders
　　　　RW = 1
　　　　For Each Fol In SubFol
　　　　　Range("B" & Format(RW)) = Fol.Name
　　　　　RW = RW + 1
　　　　Next
　　　End If
　　End Sub
3.B1以下に表示された各フォルダ名に対応する変換後のフォルダ名を、
　C1以下に入力します。
4.2.次のマクロを実行します。
　　Sub ChgDirName()
　　　Dim i, FDir, FPath1, FPath2
　　　i = 1
　　　Do While Cells(i, 2) <> ""
　　　　If Cells(i, 1) <> "" Then FDir = Cells(i, 1).Value & "\"
　　　　If Cells(i, 3).Value = "" Then GoTo Nxt
　　　　FPath1 = FDir & Cells(i, 2).Value
　　　　FPath2 = FDir & Cells(i, 3).Value
　　　　Name FPath1 As FPath2
　　Nxt: i = i + 1
　　　Loop
　　　Cells(i, 3).Value = "＜リネーム完了＞"
　　End Sub

お礼

misatoannaさんこんばんは。すごいですね。いとも簡単にプログラム
が組めるとは!
実際に使わせていただきました。フォルダ名が変わっていて感動しました。
ひとつ欲を言っていいのなら聞いてください。
私の今回の使い方として、フォルダ内にあるファイル名をそのままコピー
してフォルダ名にしたいということもあるので、フォルダの中にあるファ
イル名も取得するような仕様であれば最高です。実際のレイアウトとしては、

A1=フルパス B1=フォルダ名 C1=ファイル名 D1=変更後フォルダ名
A2=******* B2=いぬ C2=チワワ D2=ブルドッグ
C3=マルチーズ
C4=ブルドッグ
B5=ねこ
C5=三毛猫
C6=シャム
C7=アメショー
D5=シャム

というようにできないでしょうか？
うまく表組みできないので、上のように書かせていただきました。
要約すると
・１行目は項目名です。
・B列はフォルダ名
・C列はファイル名
・D列は変更後のフォルダ名
です。上の例でいくと、
(変更前)　(変更後)
いぬ　　→ブルドッグ
ねこ　　→シャム
というように、書き出されたファイル名を参考にして、コピペして
入力して、「ブルドッグ」「シャム」と変更したいと考えています。

こんなことができたらものすごく便利です。