[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『階層フォルダー内のファイルの変名』（マートン）
VBAで指定ドライブ内にある各階層フォルダー(サブフォルダー有り）内にある
全てのファイル名に指定する文字列があれば削除してリネームするようにしたいと思います。
初心者ですが以下の不完全な最初のコードを考えてみましたが
実行エラーが出ました。
「ファイルが見つかりません」
file.Name = Replace(file.Name, searchString, "") 'ファイル名を変更する
全ての階層が深いフォルダーもチェックしないと行けないので
再帰プロシージャ（自分自身を呼び出すプロシージ）の処理が必要と思われますが
難しくて自分ではコードを作成できていません。
コードの修正をお願いできませんでしょうか ？
現在のコードは以下のようですが
Option Explicit
Sub RenameFiles()
Dim folderPath As String
Dim searchString As String
Dim fso As Object
Dim folder As Object
Dim subFolder As Object
Dim file As Object
'指定するドライブのパスを設定する
folderPath = "E:"
'検索する文字列を設定する
searchString = "[DELETE]"
'FileSystemObjectを作成する
Set fso = CreateObject("Scripting.FileSystemObject")
'指定したフォルダを取得する
Set folder = fso.GetFolder(folderPath)
'指定したフォルダ内の全てのファイルを検索する
For Each file In folder.Files
'ファイル名に指定する文字列があれば、削除してリネームする
If InStr(file.Name, searchString) > 0 Then
Kill file.Path 'ファイルを削除する
file.Name = Replace(file.Name, searchString, "") 'ファイル名を変更する
End If
Next file
'指定したフォルダ内の全てのサブフォルダを検索する
For Each subFolder In folder.SubFolders
'サブフォルダ内の全てのファイルを検索する
For Each file In subFolder.Files
'ファイル名に指定する文字列があれば、削除してリネームする
If InStr(file.Name, searchString) > 0 Then
Kill file.Path 'ファイルを削除する
file.Name = Replace(file.Name, searchString, "") 'ファイル名を変更する
End If
Next file
Next subFolder
MsgBox "終了"
End Sub
＜ 使用 Excel：Excel2021、使用 OS：Windows11 ＞
（隠居Z） 2023/07/23(日) 14:24:47
そうです。
コード的には、[DELETE]を削除したファイル名に全て置き換えるです。
（マートン） 2023/07/23(日) 14:40:15
Sub 呼び出し元()
Call 処理るーちん(CreateObject("Scripting.FileSystemObject").GetFolder("E:"))
End Sub
'=====================================================
Sub 処理るーちん(ふぉるだ As Object)
Dim MyFolder As Object
Dim MyFile As Object
For Each MyFolder In ふぉるだ.SubFolders
Call 処理るーちん(MyFolder)
Next
Debug.Print ""
For Each MyFile In ふぉるだ.Files
Debug.Print MyFile.Path
Next
End Sub
■２
既にコメントがありますが、ファイルの【リネーム】をしたいのであれば【Kill】するのは適当ではないとおもいます。
（もこな２） 2023/07/23(日) 16:05:36
＞Filesを調べ始める前にさらに下位のフォルダ（SubFolder）があればそちらから取り掛かるイメージをすればよいです。
Sub 呼び出し元()
Call 処理るーちん2(CreateObject("Scripting.FileSystemObject").GetFolder("E:"))
End Sub
'=====================================================
Sub 処理るーちん2(ふぉるだ As Object)
Dim MyFolder As Object
Dim MyFile As Object
For Each MyFile In ふぉるだ.Files
If MyFile.Name Like "*[DELETE]*" Then
Debug.Print ふぉるだ.Path & vbLf & "└" & MyFile.Name & vbLf
End If
Next
For Each MyFolder In ふぉるだ.SubFolders
Call 処理るーちん2(MyFolder)
Next
End Sub
Filesを調べるのとは別に、サブフォルダがあれば当該フォルダを渡して再帰すればよく順番は関係ないですね。失礼しました。
（もこな２） 2023/07/23(日) 20:19:19
変名前にターゲットのファイルをリストアップするコードですね。
早速、処理るーちん2を試してみましたがエラーがでます。
読み込みできません。（実行エラー:70）
For Each MyFile In ふぉるだ.Files
書き換えの必要なファイル名は、
イミディエイトウインドウにDebug.printで全て表示されているようです。
（４階層のフォルダー構造を持つE:ディレクトリーで試してみました。）
思うに最後までファイルをチェックしているのに
さらにあるはずのないファイルを読みに行っているような気がします。
（全くの素人の推測なので間違っている可能性はあります。）
（マートン） 2023/07/24(月) 08:56:44
> For Each MyFile In ふぉるだ.Files でエラーになるというので、思い出したのがこちら [[20221025134710]]『最下層のフォルダー名￥ファイル名の形式で１行に書き出す - 2』（Black） なんですが、なにかヒントになれば （´・ω・`） 2023/07/24(月) 09:14:27
リンク先を見させてもらいましたが
何分スレが長すぎてポイントが素人には判別できていません。
思うに最後までファイルをチェックしているのに さらにあるはずのないファイルを読みに行っているような気がします。
この私の推察は、正しいのでしょうか？
正しいのであれば、エラーが出ても処理を続けるように
On Error Resume Next やOn Error GotoでSubを終了させれば良さそうですが ？
（マートン） 2023/07/24(月) 09:42:52
Sub main()
serch_sub "E:"
End Sub
Sub serch_sub(ByVal folderPath As String)
Dim searchString As String
Dim fso As Object
Dim subFolder As Object
Dim file As Object
Set fso = CreateObject("Scripting.FileSystemObject")
searchString = "[DELETE]"
For Each subFolder In fso.getfolder(folderPath).SubFolders
serch_sub subFolder
Next subFolder
For Each file In fso.getfolder(folderPath).Files
fso.MoveFile file, folderPath & "\" & Replace(file.Name, searchString, "")
Next file
End Sub
（mm） 2023/07/24(月) 10:12:27
あるはずないものを読むことはあり得ません。 特殊な形態のものなんでしょう。 参照記事にあるゴミ箱のような。 explorerで確認できませんか？ （xyz） 2023/07/24(月) 10:21:51
現在、USBのフラッシュメモリー(E:)においてテストDATAを使用して検証しています。
ご存じのようにフラッシュメモリーでは、ファイルを削除しても
ゴミ箱には移動されずにそのまま削除されるのでゴミ箱には何も残っていません。
そもそもフラッシュメモリーで検証するのがダメなのでしょうか？
（本チャンの外づけUSBドライブでテストするのは、
フラッシュメモリーで問題なく処理できた場合の次のステップと考えています。）
（マートン） 2023/07/24(月) 10:36:46
コードは、変名まで出来るコードですね。
検証報告だけですが、
以下で、同じエラーが出ます。
読み込みできません。（実行エラー:70）
For Each subFolder In fso.getfolder(folderPath).SubFolders
（マートン） 2023/07/24(月) 10:37:51
もこな２さんの 2023/07/23(日) 20:19:19 のコードを実行して、 >For Each MyFile In ふぉるだ.Files でエラーになるなら、エラー発生時の ふぉるだ.Name なり ふぉるだ.Path なりを調べて 特殊フォルダではないのかを調べないといけませんね というのが、私が先のログを紹介した意図です
>For Each subFolder In fso.getfolder(folderPath).SubFolders このときの folderPath は？ そういうのを調べるのがデバッグでは重要です （´・ω・`） 2023/07/24(月) 10:40:35
Sub serch_sub(ByVal folderPath As String) 'arg=フォルダ
Dim searchString As String
Dim fso As Object
Dim subFolder As Object
Dim file As Object
Set fso = CreateObject("Scripting.FileSystemObject")
searchString = "[DELETE]"
On Error GoTo ere
For Each subFolder In fso.getfolder(folderPath).SubFolders
serch_sub subFolder
Next subFolder
For Each file In fso.getfolder(folderPath).Files
fso.MoveFile file, folderPath & "\" & Replace(file.Name, searchString, "")
Next file
Exit Sub
ere:
MsgBox "folderPath = " & vbLf & folderPath & vbLf & vbLf & "subFolder = " & vbLf & subFolder, , "エラー"
End Sub
（mm） 2023/07/24(月) 11:04:42
エラー発生時の ふぉるだ.Name なり ふぉるだ.Path なりを調べてみました。
イミディエイトウインドウのDebug.printでは、
? ふぉるだ.Name
System Volume Information
? ふぉるだ.Path
E:\System Volume Information
いずれも同じ名前です。
説明にあるように
System Volume Informationフォルダーは、普通のユーザーが触れる必要のない特殊フォルダーです。
なのでこのフォルダーを読み込みフォルダーに含めないようにすれば良さそうです。
ネットで情報を調べていますが、なかなかそのまんまがヒットしません。
（マートン） 2023/07/24(月) 11:12:01
´・ω・`さんへの回答（11：12）と同じ結果がmsgboxに表示されます。
folderPath = E:
Subfolder = E:\System Volume Information
やはり、特殊フォルダーを読みに行っているようです。
（マートン） 2023/07/24(月) 11:19:03
SUBプロシジャの最初にシステムフォルダかどうかを判定して、Exit Sub しちゃいましょう （´・ω・`） 2023/07/24(月) 11:54:54
Folderオブジェクト - Attributesプロパティ http://officetanaka.net/excel/vba/filesystemobject/folder01.htm とか Attributes プロパティ https://learn.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/attributes-property とかをよんでください （´・ω・`） 2023/07/24(月) 12:04:37
■３
＞変名前にターゲットのファイルをリストアップするコードですね。
違います。【リネーム】というヒントは出したので、そちらはわかるだろうと思い再帰のほうだけ説明したつもりです。
■４
＞読み込みできません。（実行エラー:70）
実は私もドライブ直下を指定するとエラーが発生したんですよね.....
面倒なので調べませんでしたが、【システムフォルダ】を読みにいっているのが問題なのであれば、そいつは処理しなければよいと思います。
（´・ω・`）さんのアドバイスのように直ぐに抜けてもよいと思います。
【参考】 http://officetanaka.net/excel/vba/filesystemobject/folder01.htm
Sub 呼び出し元()
Call 処理るーちん2改(CreateObject("Scripting.FileSystemObject").GetFolder("U:"))
End Sub
'=====================================================
Sub 処理るーちん2改(ふぉるだ As Object)
Dim MyFolder As Object
Dim MyFile As Object
For Each MyFile In ふぉるだ.Files
If MyFile.Name Like "*xls*" Then
Debug.Print ふぉるだ.Path & vbLf & "└" & MyFile.Name & vbLf
End If
Next
For Each MyFolder In ふぉるだ.SubFolders
If Not MyFolder.Attributes And 4 Then
Call 処理るーちん2改(MyFolder)
End If
Next
End Sub
（もこな２ ） 2023/07/24(月) 12:27:00
Callするときにシステムの隠しフォルダでCallする人もいないとは思いますが、 やっぱりプロシジャ冒頭でチェックしたほうが安全かなと思いました
ですが、ちょっとやってみたところ、ルートフォルダはシステムフォルダなんですね
なので、プロシジャ冒頭でシステムフォルダならExit Sub する方針だと、
ルートフォルダのときは別に考慮しないといけないようです
Enum FileAttribute
Normal = 0
ReadOnly = 1
Hidden = 2
System = 4
Volume = 8
Directory = 16
Archive = 32
End Enum
Sub main()
ListUPFiles "E:\"
End Sub
Sub ListUPFiles(fPath As String)
Dim oFolder As Object, f As Object
Set oFolder = CreateObject("Scripting.FileSystemObject").GetFolder(fPath)
If (Not oFolder.isRootFolder) And (oFolder.Attributes And (FileAttribute.System + FileAttribute.Hidden)) Then Exit Sub
For Each f In oFolder.Files
Debug.Print f.Path ' 名前を変える処理はここで。
Next
For Each f In oFolder.SubFolders
ListUPFiles f.Path
Next
End Sub
（´・ω・`） 2023/07/24(月) 13:02:06
´・ω・`さんの13：02のコードでエラー無く
Debug.Print f.Path
が表示されたのでRENAMEをすべく
mmさんのコードを拝借して以下のように考えてみましたが
エラーがでました。
プロシージャの呼び出し、または引数が不正です。
f.Name = f.Path & "\" & Replace(f.Name, "[DELETE]", "")
Option Explicit
Enum FileAttribute
Normal = 0
ReadOnly = 1
Hidden = 2
System = 4
Volume = 8
Directory = 16
Archive = 32
End Enum
’--------------------------------------
Sub main()
ListUPFiles "E:\"
End Sub
Sub ListUPFiles(fPath As String)
Dim oFolder As Object, f As Object
Set oFolder = CreateObject("Scripting.FileSystemObject").GetFolder(fPath)
If (Not oFolder.isRootFolder) And (oFolder.Attributes And (FileAttribute.System + FileAttribute.Hidden)) Then Exit Sub
For Each f In oFolder.Files
If f.Name Like "*[DELETE]*" Then
f.Name = f.Path & "\" & Replace(f.Name, "[DELETE]", "")
End If
Next
For Each f In oFolder.SubFolders
ListUPFiles f.Path
Next
End Sub
（マートン） 2023/07/24(月) 16:31:09
確認してください (1) mmさんはそのようなコードは書いてないのので確認すること (2) f.name,f.pathがどのような値になっているか確認すること (3) (2)のとき、 f.Path & "\" & Replace(f.Name, "[DELETE]", "") がどのような値になっているか確認すること (4) (3)のとき、変更しようしている名前が既に使われていないか確認すること。 (5) FileオブジェクトのNameプロパティは、Pathを含みません これ大事 （´・ω・`） 2023/07/24(月) 17:15:59
(1) mmさんはそのようなコードは書いてないので確認すること
「拝借して」とは、ｍｍさんの folderPath & "\" & Replace(file.Name, searchString, "") を拝借して f.Path & "\" & Replace(f.Name, "[DELETE]", "") と考えたと言う事です。
(2) f.name,f.pathがどのような値になっているか確認すること
? f.name
[DELETE]Sumple.txt
? f.path
E:\[DELETE]Sumple.txt
f.pathがE:の後にファイル名が表示されていておかしい。
(3) (2)のとき、 f.Path & "\" & Replace(f.Name, "[DELETE]", "") がどのような値になっているか確認すること
? f.Path & "\" & Replace(f.Name, "[DELETE]", "")
E:\[DELETE]Sumple.txt\[DELETE]Sumple.txt
f.pathがおかしい（不正な文字列）ので
E:\[DELETE]Sumple.txtでない。
(5) FileオブジェクトのNameプロパティは、Pathを含みません これ大事
なのでf.pathでパスを取得するように考えたのですが
f.path自体がパス＋ファイル名のようなおかしな表示になっています。
pathなのになぜファイル名も一緒になるのかが理解できていません。
（マートン） 2023/07/24(月) 18:34:21
そういう仕様です ＞Path プロパティにはファイル名と拡張子が含まれます。
仕様を確認して、仕様にそってコーディングしましょう （´・ω・`） 2023/07/24(月) 18:47:25
大事なことなのでもう一度 (5) FileオブジェクトのNameプロパティは、Pathを含みません
f.nameは取得と代入（変更）と両方できますが 代入するときにpathを含めて指定するとエラーになります
pathを変更するとき（フォルダを移動するときは）別のメソッドをつかいまふ （´・ω・`） 2023/07/24(月) 18:56:51
下記で目的は果たしていると思いますがアドバイス有ればお願いします。
個人的には、問題になりそうなのが、
１）変名したら同名ファイルがある場合で
ファイル名の最後に(2)のように番号を追加するなどの作業は必要と思われます。
２）削除すべき文字列（searchStr）をコードの中ではなく
Sub main()の中でINPUTBOX等で指定する
です。
Enum FileAttribute
Normal = 0
ReadOnly = 1
Hidden = 2
System = 4
Volume = 8
Directory = 16
Archive = 32
End Enum
'----------------------------------
Sub main()
RenameFilesInFolder "E:\"
End Sub
Sub RenameFilesInFolder(folderPath As String)
'Dim folderPath As String
Dim searchStr As String
Dim file As Object
Dim files As Object
Dim fPath As Object
' フォルダーパスと検索文字列を指定
'folderPath = "E:"
searchStr = "[DELETE]"
' フォルダー内の全てのファイルを取得
Set files = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).files
Set fPath = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath)
If (Not fPath.isRootFolder) And (fPath.Attributes And (FileAttribute.System + FileAttribute.Hidden)) Then Exit Sub
' ファイル名を変更
For Each file In files
If InStr(file.Name, searchStr) > 0 Then
file.Name = Replace(file.Name, searchStr, "")
End If
Next file
For Each file In fPath.subFolders
RenameFilesInFolder file.Path
Next
MsgBox "ファイル名の変更済み。"
End Sub
（マートン） 2023/07/25(火) 10:49:06
MsgBox 出してますけど、MsgBox の位置はそこでいいですか？ 1つのフォルダを処理する毎にMsgBoxがでたら、私ならうっとうしいと思いますが、 そうしたい人もいるでしょうから、そうしたいならそうすればいいのでしょうけど （´・ω・`） 2023/07/25(火) 11:20:41
・CreateObject("Scripting.FileSystemObject")をフォルダごとに作成する（しかも二度）は
無駄かも。
moduleベースの変数にして、mainで一度定義すればよいと思います。
・searchStrもフォルダ毎にかわらないはずなので、同様に、
moduleベースの変数にして、mainで一度定義すればよいかも。
（xyz） 2023/07/25(火) 11:38:25
確かに、毎回表示が出るのは煩わしいので以下に変更しました。
Sub main()
RenameFilesInFolder "E:\"
MsgBox "ファイル名の変更済み。"
End Sub
xyzさん、アドバイスありがとうございます。
＞＞CreateObject("Scripting.FileSystemObject")をフォルダごとに作成する（しかも二度）は
＞＞無駄かも。 ＞＞moduleベースの変数にして、mainで一度定義すればよいと思います。
初心者なので行き当たりばったりでコードを作成しているため
頓珍漢な点が出来てしまします。
CreateObjectを1回で済ますなら以下で考えました。
Set fPath = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath)
files=fpath.files
「moduleベースの変数にして、mainで一度定義すればよい」
これ理解出来ませんでした。
mainの方で定義したほうがなぜ良いのでしょうか？
＞＞searchStrもフォルダ毎にかわらないはずなので、同様に、
＞＞ moduleベースの変数にして、mainで一度定義すればよいかも
削除すべき文字列（searchStr）をコードの中ではなく
Sub main()の中でINPUTBOX等で指定する事は次の宿題と考えていますが
moduleベースの変数で定義とは？どのような事でしょうか ？
教えてください。
（マートン） 2023/07/25(火) 13:48:18
なんだか xyzさんの指摘は妥当な指摘ですけれども、 人のコードまるまる使っておいて、それが頓珍漢だといわれると少々つらい気持ち
消えます （´・ω・`） 2023/07/25(火) 14:28:12
（´・ω・`）さん、 >アドバイス有ればお願いします。 と質問者さんからあったので、 そのほうがよいかなと思いメモを書きました。 横から口を挟みまして申し訳ありませんでした。 問題解決のすべては（´・ω・`）さんの貢献であることはよく承知しています。
以下、質問者さんからの質問への回答です。 モジュール変数については、 http://officetanaka.net/excel/vba/variable/05.htm を参考にしてください。
（xyz） 2023/07/25(火) 14:50:10
確かに、根幹にかかわるところはコードをそのまま利用させていただきましたが
ファイル名変名のところは自分で調べて行き当たりばったりでコードを作成しました。
そのため達人さんから見ると自前のコードで頓珍漢な点だあるのではと言いたかった訳で
´・ω・`のコードが頓珍漢だと思っての発言ではありません。
いずれにしても気を悪くされたようなので失礼をお詫びします。
ｘｙｚさん、助言ありがとうございます。
´・ω・`さんからも更なるアドバイスも無いとの事なので
後は、自分で調べて対処いたします。
お世話になりました。
（マートン） 2023/07/25(火) 15:11:15
■５
私が「2023/07/24(月) 12:27:00」に提示したものに手を入れた場合↓みたいな感じになったのではないかと思います。
Sub 呼び出し元()
Dim 親フォルダパス As String, 削除文字列 As String
親フォルダパス = "E:"
削除文字列 = "[DELETE]"
Call サブルーチン(CreateObject("Scripting.FileSystemObject").GetFolder(親フォルダパス), 削除文字列)
End Sub
'=========================================================================
Sub サブルーチン(ふぉるだ As Object, 削除文字列 As String)
Dim MyFolder As Object
Dim MyFile As Object
For Each MyFolder In ふぉるだ.SubFolders
If Not MyFolder.Attributes And (2 + 4) Then'【Hidden:2、System:4】以外を処理
Call サブルーチン(MyFolder, 削除文字列)
End If
Next
For Each MyFile In ふぉるだ.Files
If MyFile.Name Like "*" & 削除文字列 & "*" Then
MyFile.Name = Replace(MyFile.Name, 削除文字列, "")
End If
Next
End Sub
■６
基本的には上記で動作するとおもいますが、指摘があるように【同名ファイル】があった場合はリネームに失敗（エラーが発生）しますから、そういったことが懸念されるならば、それなりの手当をしておくことを推奨します。
※以下は研究材料として提示しています。丸パクリして完成！というのはご遠慮ください。
Sub 呼び出し元()
Dim 親フォルダパス As String, 削除文字列 As String
親フォルダパス = "E:"
削除文字列 = "[DELETE]"
Call サブルーチン(CreateObject("Scripting.FileSystemObject").GetFolder(親フォルダパス), 削除文字列)
End Sub
'=========================================================================
Sub サブルーチン(ふぉるだ As Object, 削除文字列 As String)
Dim MyFolder As Object
Dim MyFile As Object
Dim リネーム後 As String
Dim 枝番 As Long
Dim tmp As String
Dim ベース名 As String, 拡張子 As String
For Each MyFolder In ふぉるだ.SubFolders
If Not MyFolder.Attributes And (2 + 4) Then '【Hidden:2、System:4】以外を処理
Call サブルーチン(MyFolder, 削除文字列)
End If
Next
For Each MyFile In ふぉるだ.Files
If MyFile.Name Like "*" & 削除文字列 & "*" Then
リネーム後 = Replace(MyFile.Name, 削除文字列, "")
'▼当該フォルダに同名ファイルが既にないかチェック
If CreateObject("Scripting.FileSystemObject").FileExists(MyFile.ParentFolder & "\" & リネーム後) = True Then
'▼同名ファイルがあったら【ベース名】と【拡張子】に分解
ベース名 = CreateObject("Scripting.FileSystemObject").GetBaseName(リネーム後)
拡張子 = CreateObject("Scripting.FileSystemObject").GetExtensionName(リネーム後)
'▼使ってない枝番を調べて
枝番 = 1
Do Until CreateObject("Scripting.FileSystemObject").FileExists(MyFile.ParentFolder & "\" & ベース名 & "(" & 枝番 & ")." & 拡張子) = False
枝番 = 枝番 + 1
Loop
'▼枝番をつけたファイル名を組み立てる
リネーム後 = ベース名 & "(" & 枝番 & ")." & 拡張子
End If
MyFile.Name = リネーム後 '★実際にリネームしているのはココ
End If
Next
End Sub
（もこな２ ） 2023/07/26(水) 15:04:42
＞If MyFile.Name Like "*" & 削除文字列 & "*" Then
試してないけど問題ないの？ （？？） 2023/07/26(水) 17:09:00
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.