ファイル名を変更するマクロ

あるフォルダ内にエクセルファイルが複数あります。
そのエクセルファイルの名前の一部を一括で変更する
エクセルマクロを教えて下さい。
下記のように「課題」の部分を「完了」に変更したい。
例：
変更前
1201課題.xls
1202課題.xls
1203課題.xls
1204課題.xls
変更後
1201完了.xls
1202完了.xls
1203完了.xls
1204完了.xls

説明不足かもしれませんが、宜しく御願い致します。

No.3 ベストアンサー 回答者： Wendy02 回答日時： 2009/12/25 12:17

こんにちは。

本来は、UserForm に取り付ければよいのですが、掲示板提供では、そういうわけにも行かないので、工夫しました。
ピンボイントの回答もあるけれども、ある程度の汎用性があるものを作らなければ、後付けで、わざわざ書く意味もありません。

1201課題.xls　→1201完了.xls
また、
1201.xls　という場合も、課題1201.xls　ということも可能です。

もう少し、コードをきれいに整頓する必要性は感じますが、参考程度にしてください。
マクロというのは、対話型ではなく、動作を見えないままに一括変換することが多いので、その場合は、他のサンプルを参考にしてください。また、対話型なら、実際には、ユーティリティを使ったほうが良いような気もします。

'-------------------------------------------
'標準モジュール登録用
Sub FileNameChange()
　　Dim nFiles As Variant
　　Dim sText As Variant
　　Dim sRept As Variant
　　Dim tmp As Variant
　　Dim ret As VbMsgBoxResult
　　Dim BaseName As String
　　Dim fName As String
　　Dim i As Long
　　Dim v As Variant
''=========================================
　　Const sEXT As String = "*.xl*"　'拡張子
''=========================================
　　nFiles = Application.GetOpenFilename("Excel(" & sEXT & ")," & sEXT, , "ファイル名変更", , True)
　　If VarType(nFiles) = vbBoolean Then Exit Sub
　　i = InStrRev(nFiles(1), "\")
　　BaseName = Mid(nFiles(1), 1, i)
　　tmp = Mid(nFiles(1), i + 1)
　　sText = Application.InputBox(tmp & vbCrLf & "検索する単語を入れてください。", "検索する単語", Type:=2)
　　If VarType(sText) = vbBoolean Or sText = "" Then Exit Sub
　　
　　sRept = Application.InputBox(tmp & vbCrLf & "置換する単語を入れてください。" & vbCrLf _
　　& "削除する場合や付加する場合は、そのままOK/Enterを入れてください。", "置換する単語", Type:=2)
　　If VarType(sRept) = vbBoolean Then Exit Sub
　　
　　If InStr(1, tmp, sText, 1) > 0 Then
　　 ret = MsgBox("例:" & Replace(tmp, sText, sRept, , 1, 1) & vbCrLf & _
　　 "このようにしますか？" & vbCrLf & "ファイル名に付加する場合はNo/いいえ", vbInformation + vbYesNoCancel)
　　Else
　　　ret = vbNo
　　End If
　　
　　If ret = vbCancel Then
　　　　Exit Sub
　　End If
　　
　　If ret = vbNo Then　'オプション
　　　　ret = MsgBox(sText & "を付加します。" & vbCrLf & "Yes/ファイル名の手前(Prefix)　" & _
　　　　"No/拡張子の手前(Sufix)" & vbCrLf & "Cancel/取りやめ", _
　　　　vbInformation + vbYesNoCancel, "ファイル名変更")
　　　　If ret = vbYes Then
　　　　　　Call AddFileNameChange(sText, nFiles, 1)
　　　　　　GoTo EndLine
　　　　ElseIf ret = vbNo Then
　　　　　　Call AddFileNameChange(sText, nFiles, 0)
　　　　　　GoTo EndLine
　　　　Else
　　　　　　Exit Sub
　　　　End If
　　End If
　　
　　For Each v In nFiles
　　　　fName = Replace(v, BaseName, "", , 1, 1)
　　　　Name v As BaseName & Replace(fName, sText, sRept, , 1, 1)
　　Next v

EndLine:
　　If MsgBox("終了しました。確認しますか？", vbQuestion + vbOKCancel) = vbOK Then
　　　tmp = Application.GetOpenFilename("Excel(" & sEXT & ")," & sEXT, , "ファイル名変更")
　　End If
End Sub

Sub AddFileNameChange(ByVal sText As String, nFiles As Variant, Optional location As Long)
　　Dim i As Long
　　Dim v As Variant
　　If location = 1 Then
　　　　'Prefix
　　　　For Each v In nFiles
　　　　　　i = InStrRev(v, "\")
　　　　　　Name v As Mid(v, 1, i - 1) & "\" & sText & Mid(v, i + 1)
　　　　Next v
　　Else
　　　　'Sufix
　　　　For Each v In nFiles
　　　　　　i = InStrRev(v, ".")
　　　　　　Name v As Mid(v, 1, i - 1) & sText & Mid(v, i)
　　　　Next v
　　End If
End Sub

この回答へのお礼

完璧です。
大変助かりました。
私もこのようなプログラムが組める様に頑張ります。
ありがとうございました。

お礼日時：2009/12/27 00:22

No.2 回答者： imogasi 回答日時： 2009/12/25 09:49

あるフォルダを処理すれば、他のフォルダを考える必要は無い情況と思います。

（１）あるフォルダの全ファイル名を捉えるコードはWEBにあふれている。
Googleででも「VBA ファイル名 取得」や「vba フォルダ　ファイル名 取得」で照会する。
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub0 …
ほか多数。
その中から目的（処理対象）のブック（ファイル）名を選別するのは、質問に書いてないが
・エクセルブックｘｌｓであること
・ファイル名に「課題」という文字を含んでいること
か？この点質問者が考えて、はっきり書かないと、部外者には情況がわからないのだ。
フォルダの全ファイルの場合は選別は不要なのは当たり前だが、どうかな。
（２）そのファイルを捉えたとして、ファイル名の変更は、これもWEBですぐ判る。
これもGoogleなどで「VBA　ファイル名変更」で照会すれば、多数の記事がある。
http://officetanaka.net/excel/vba/tips/tips91.htm
など多数。
結局、WEB照会もせず、質問しているのではないですか。
プログラムを書こうとする場合、WEB照会ぐらい習慣付けないと。

この回答へのお礼

今後の参考にして勉強します。
ありがとうございました。

お礼日時：2009/12/27 00:24

No.1 回答者： NOBNNN 回答日時： 2009/12/25 01:45

参考：

■ VBAでファイルの操作
http://officetanaka.net/excel/vba/tips/tips91.htm

　■ ファイルの移動、ファイル名の変更、ファイルの削除
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub0 …


上記のコードサンプルを参考にしてください。

　実際には　ボタンや　リストボックス　などを用いて　画面を作って　あげれば

　操作性が　よくなります。



　

参考URL：http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub0 …

この回答へのお礼

今後の参考にして勉強します。
ありがとうございました。

お礼日時：2009/12/27 00:25