[[20170116220914]]　『ファイル名に特定の文字を含むファイルを調べたい』（失抹）　ページの最後に飛ぶ

『ファイル名に特定の文字を含むファイルを調べたい』（失抹）

ファイル名に特定の文字を含むファイルを調べ、指定のファイル名に書き換えたいです。

「1月1日」「1月2日」などのフォルダがあり、その中に「a0101DB02.txt」[a0101QW02.txt]のようなファイルがいくつか入っています。
このファイルの中で、特定の文字というのは左から6番目～2文字のことです。
特定の文字は"DB" "QW" "FW"　3種類あり、その文字を見て、フォルダ名と合わせてDBなら「1月1日_DB0001」QWなら「1月1日_QW0001」FW「1月1日_FD0001」というファイル名を付けたいと思っています。（FWの場合は抜出ではなく別の単語に変わります。）複数同じファイルがあった場合は、「1月1日_DB0001_01」「1月1日_DB0001_02」という風に後ろに「_**」と番号を振りたいと思っています。
ファイル名を変更するためのブックを作成し、マクロを実行して変更出来たら良いと思っています。

どなたかご存知でしたらご教示下さい。よろしくお願いいたします。

01171044:小文字→大文字に修正しました。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

こんにちは

ファイル名を付けたいとは、

「a0101db02.txt」を「1月1日_db0001.txt」にリネームするという事ですか？

それとも、新しい名前で新しいファイルを作るのですか？

（ウッシ） 2017/01/17(火) 08:15

ウッシ様

御回答ありがとうございます。
新しいファイルは作成せず、リネームするということです。
（失抹） 2017/01/17(火) 08:50

 私からも質問。

 >>「1月1日」「1月2日」などのフォルダ

 『などの』ということは、ほかにも処理したいフォルダがあるわけですね。
 これらのフォルダは、どう指定して実行することを想定していますか？
 「1月1日」とか「1月2日」とか、必要なものを１つずつ（失抹さんが指定して）処理していく考えですか？
 それとも、マクロ内で自動的に、『などの』フォルダをすべて対象にしたいのですか？

 後者であれば、その『などの』フォルダが、どこかのフォルダ内にサブフォルダとして存在する、
 そのフォルダ内には、それ以外のサブフォルダがない。　といった　条件って　何かありますか？

 >>その中に「a0101db02.txt」[a0101qw02.txt]のようなファイル

 『のような』が気になります。
 対象フォルダ内のファイルの内、処理対象は、その名前が

 1桁の英文字
 4桁の数字
 2桁の英文字
 2桁の数字

 こうなっているものに限定する　といったことでいいのですか？
 それとも、それ以外にも、処理対象の　『のような』ファイルがあるということでしょうか？

（β） 2017/01/17(火) 10:11

β様

御回答ありがとうございます。
質問に不備が多々あり申し訳ございません。

＞＞それとも、マクロ内で自動的に、『などの』フォルダをすべて対象にしたいのですか？
はい、本文に記載した以外のフォルダも存在していますのですべてを対象にしたいと思っています。
条件はなく、サブフォルダはすべてのフォルダに存在しません。ですが、本文に記載しました特定の文字3種類のほかに、TS,RHなどリネームする必要のないファイルが含まれている場合があります。

＞＞それとも、それ以外にも、処理対象の　『のような』ファイルがあるということでしょうか？
特定の文字は必ず「左から6番目～はじまる2桁の半角大文字の英文字」です。（本文は小文字で書いてしまいましたが正しくは大文字です。申し訳ありません。）ファイル名頭の「a0101」やファイル名後ろの「02」の部分は変わる場合がありますので指定ができません。「のような」という言葉は余計でした…混乱させてしまい申し訳ございません。

（失抹） 2017/01/17(火) 10:41

 ファイル名についてはわかりました。

 フォルダについて。
 それは困りましたねぇ。（処理するマクロから見て困るなぁということです）

 具体的に、たとえば　「1月1日」というフォルダは、どこにあるのでしょうか？

 ＰＣ内には CドライブとかDドライブとか、ＰＣによっては　他のドライブとか、ありますよね。
 で、たとえば Cドライブの中には、Users とか Proguram Files とか、数多くのフォルダがありますね。
 さらに Users には　xxxxxx という　ログインIDに紐付くフォルダや、その他のフォルダがありますね。
 xxxxxx の中にも DeskTop や Documents といった　数多くのフォルダがありますね。
 さらに、DeskTop や Documents といったフォルダ内にも、自分で作成した様々なフォルダがありますね。
 その自分で作成したフォルダの中にもさらに　子フォルダ、孫フォルダ、・・・・　があるかもしれませんね。

 そういった中で、『1月1日』というフォルダを探し出す？
 何も条件をマクロに与えてやらないとすれば、２つ問題があります。

 １．膨大な時間がかかります。
 ２．数多くのフォルダの中から対象とすべきフォルダをどう選別するか？　
 　　名前が数字+月+数字+日　という構成のものを相手にするのか？

 このあたり、『条件はなく』といわれると、困ってしまうんですが、失抹さんとしては、どう考えますか？

（β） 2017/01/17(火) 11:21

かなり面倒でしたよ…。決して「ご存知」な内容を貼った訳ではないですからね。追加要望はご勘弁を。
cPATHには、日付フォルダの1つ上の階層を指定してください。

 Sub test()
    Const cPATH = "C:\tmp\test\"
    Dim cFiles As Variant
    Dim vw As Variant
    Dim i As Long
    Dim iw As Long
    Dim iNum As Long
    Dim cw As String

    iNum = UBound(Split(cPATH, "\")) + 1

    cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & cPATH & "*.txt""").StdOut().ReadAll(), vbNewLine)
    For i = 0 To UBound(cFiles) - 1
        vw = Split(cFiles(i), "\")
        If UBound(vw) = iNum Then
            If IsDate(vw(iNum - 1)) = True Then
                If 6 < Len(vw(iNum)) Then
                    Select Case Mid(vw(iNum), 6, 2)
                    Case "DB", "QW", "FW"
                        cw = Replace(cFiles(i), "\" & vw(iNum), "\" & vw(iNum - 1) & "_" & Split(vw(iNum), ".")(0))
                        If Dir(cw & "*.txt") = "" Then
                            cw = cw & ".txt"
                        Else
                            iw = UBound(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & cw & "*.txt""").StdOut().ReadAll(), vbNewLine))
                            cw = cw & "_" & Format(iw, "00") & ".txt"
                        End If
                        Name cFiles(i) As cw
                    End Select
                End If
            End If
        End If
    Next i
 End Sub
（???） 2017/01/17(火) 11:24

β様

御回答ありがとうございます。
自分で作成しようと途中まで試したときは、フォルダのパスを指定して、指定したフォルダ内にあるフォルダを対象としてできたら良いと思いました。

    Const cnsTitle = "フォルダ内のファイル名一覧取得"
    Const cnsDIR = "\*.*"
    Dim xlAPP As Application
    Dim vntPathName As Variant

    Set xlAPP = Application
    ' InputBoxでフォルダ指定を受ける
    vntPathName = xlAPP.InputBox("参照するフォルダ名を入力して下さい。", _
                                 cnsTitle, "C:\") 
（引用　http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html）

指定するフォルダのパスはデスクトップやCドライブなどの一番上にあるものではなく、リネームしたいフォルダだけを入れたフォルダを作成しようと思っているのですが、如何でしょうか…？
（失抹） 2017/01/17(火) 11:35

???様

御回答ありがとうございます。
まだ実行しておりませんが、これから試してみます。貴重な時間をありがとうございました。
（失抹） 2017/01/17(火) 11:41

 >>自分で作成しようと途中まで試したときは、フォルダのパスを指定して、
 >>指定したフォルダ内にあるフォルダだけを対象としてできたら良いと思いました。

 でしょ。

 そういった条件をお聞きしたかったんです。

 了解しました。

 つまり

 親フォルダ <-- 操作者に選ばせる
　　対象フォルダ　は、この選んだフォルダ内のすべてのサブフォルダ

 こういうことでいいのですね？

（β） 2017/01/17(火) 11:51

β様

β様のおっしゃる通りです！
言葉が足らず申し訳ございません。
（失抹） 2017/01/17(火) 13:40

私のマクロ例の注意点なぞ、追記しておきます。

（1）「1月1日」フォルダの「a0101DB02.txt」は、とりあえず「1月1日_a0101DB02.txt」としています。「a」が固定なのか判らなかったし、「DB」の後ろの数字桁数が変わっているのも、ミスなのかどうか判らなかったので。整形したい場合、Mid関数やFormat関数で、cwを編集している箇所を変えるだけなので、そこはお好きに修正してみてください。

（2）副番が付くのは「_01」からとしています。つまり、「1月1日_a0101DB02.txt」が1件目。「1月1日_a0101DB02_01.txt」が2件目です。 1つズレているのが気になりましたが、2件目が発生した際に1件目を「_01」に変える、なんていう処理の方が、もっと変だと思ったため。

（3）フォルダをダイアログで選択したいならば、得られたフルパスをcPATHに代入してください。このとき、必ず末尾に"\"を付けるように。
（???） 2017/01/17(火) 15:19

 ???さんから効率面では最速の１つである DIRコマンドと　ＶＢＡ標準機能の組み合わせのコード案がアップされていますが
 効率面では、やや難のある FSO を使ってみました。

 そちらのコードでは親フォルダをINPUTBOX に生入力する方式になっていましたが
 フォルダを選択する方式にしました。フォルダ選択は、他にも様々なものがありますが
 とりあえず、コードがシンプルなものにしてあります。

 ざっと動く確認しかしていませんので、不具合あるいは、こちらの勘違いあれば指摘願います。

 (アップ後、フォルダ選択画面のタイトル追加しました。 15:30)

 Sub Sample()
    Dim fso As Object
    Dim pPath As String
    Dim sFold As Object
    Dim myFile As Object
    Dim nName As String
    Dim nw As String
    Dim ow As String
    Dim cnt As Long
    Dim sfx As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "参照するフォルダを選択してください"
        If Not .Show Then Exit Sub  'キャンセルボタン
        pPath = .SelectedItems(1)
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")

    For Each sFold In fso.getfolder(pPath).SUbFolders
        For Each myFile In sFold.Files
            If LCase(fso.getextensionname(myFile.Name)) = "txt" Then
                ow = Mid(myFile.Name, 6, 2)
                Select Case ow
                    Case "DB", "QW": nw = ow
                    Case "FW": nw = "FD"
                    Case Else: nw = ""
                End Select
                If nw <> "" Then
                    sfx = ""
                    cnt = 0
                    Do
                        nName = sFold.Path & "\" & sFold.Name & "_" & nw & "0001" & sfx & ".txt"
                        If Not fso.FileExists(nName) Then Exit Do
                        cnt = cnt + 1
                        sfx = "_" & Format(cnt, "00")
                    Loop

                    fso.MoveFile myFile.Path, nName                   '

                End If
            End If
        Next
    Next

 End Sub

（β） 2017/01/17(火) 15:20

そうか、FWだったらFDに変えるという条件もありましたね。これは見落としてました。
しっかし、最初のリネームでも副番を付ける仕様の方が、処理が一本化しますよねぇ。副番の有無で、無意味に処理分岐しちゃう。

また、βさんは条件通り「DB02」を「DB0001」に変えましたが、元の数字を引き継がず必ず1にして、あとは副番にする、という条件も意味不明ですよね。ちゃんと条件提示できていない気がします。全部同じにリネームするのならば、DIR関数がファイルを見つける順番は不特定な点が問題になりそうです。（/OD や /ON 指定でソートしますが、NASの場合はこれが効かないという…）
（???） 2017/01/17(火) 16:11

 >>元の数字を引き継がず必ず1にして、あとは副番にする、という条件も意味不明ですよね。

 私も、ちょっと違和感の残るファイル名作成ルールだと思いますね。
 元の様々な番号は何だったんだろうか？

 ただ、副番の設定ルールは、（こちらがどうこういうことではないのですが）、これはこれで
 ありうるかなと。　基本、まず重複しないだろう。だから基本、副番なし。
 万が一あれば _01、_02、・・・
 ただ、この場合、最初は _02 から始めたほうがよろしいような気もしますけど。

（β） 2017/01/17(火) 16:27

???様、β様

御回答ありがとうございます。返信が遅くなってしまい申し訳ございません。

元の数字を引き継がない理由として、元のデータは別の管轄で作成している為、順番になっておらずどのようなルールで番号が付与されているのか不明だからです。
リネームの番号も、ルールに則っているので、やや分かり難いとは思うのですがこのまま進めたいと思います。最後まで丁寧に考えて頂きまして本当にありがとうございます。

コード確認致しました。
お二方とも、初心者の私でも分かりやすいもので大変参考になります。
この度はどうもありがとうございました。m(_ _)m
（失抹） 2017/01/17(火) 18:12

コメント返信：

[ 一覧(最新更新順) ]

[[20170116220914]] 『ファイル名に特定の文字を含むファイルを調べたい』（失抹） ページの最後に飛ぶ

[[20170116220914]]　『ファイル名に特定の文字を含むファイルを調べたい』（失抹）　ページの最後に飛ぶ