VBA 特定文字含むファイル

vbaを利用しフォルダ内にある複数のふぁいるから、特定文字を含むファイルをリストアップする方法を教えて下さい。

・条件・
.txtファイル
1つのフォルダに有り（サブフォルダなし）
約5000ファイル有り
「リンゴ」「みかん」「バナナ」を含むファイル（ファイル内に記載されているもの）

・ほしいもの・
エクセルデータに特定文字列を含むファイル名と、その特定文字をリストアップする

No.2 回答者： Qchan1962 回答日時： 2020/08/04 17:08

こんにちは、

私も同意しますね。が、Excel　VBAでやる場合
不明確なところ
文字コードは？UTF-8で良いのかな？
書き出すシートは？どこでしょうか？　独断でインデックス1番にします。（ここに新規シートを追加してください）

Sub sample1()
　　Dim n As Long, i As Long
　　Dim filepath As String, fName As String, buf As String
　　Dim fso As Object
　　Dim file, files, AryKey
　　Dim myAry(6000, 3)
　　Dim flag As Boolean

　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.Title = "フォルダを選択してください"
　　　　If .Show = True Then
　　　　　　filepath = .SelectedItems(1)
　　　　End If
　　End With
　　If filepath = "" Then Exit Sub
　　Sheets(1).Cells.ClearContents
　　Set fso = CreateObject("Scripting.FileSystemObject")
　　Set files = fso.GetFolder(filepath).files
　　'On Error Resume Next
　　For Each file In files
　　　　n = 1
　　　　flag = False
　　　　If fso.GetExtensionName(file) = "txt" Then
　　　　　　fName = fso.GetBaseName(file)
　　　　　　With CreateObject("ADODB.Stream")
　　　　　　　　.Charset = "UTF-8"
　　　　　　　　.Open
　　　　　　　　.LoadFromFile (file)
　　　　　　　　buf = .ReadText(-1)　　　　'adReadAll
　　　　　　　　For Each AryKey In Array("リンゴ", "みかん", "バナナ")
　　　　　　　　　　If InStr(buf, AryKey) > 0 Then
　　　　　　　　　　　　myAry(i, 0) = fName
　　　　　　　　　　　　myAry(i, n) = AryKey
　　　　　　　　　　　　n = n + 1
　　　　　　　　　　　　flag = True
　　　　　　　　　　End If
　　　　　　　　Next
　　　　　　　　.Close
　　　　　　End With
　　　　　　If flag = True Then i = i + 1
　　　　End If
　　Next file
　　Sheets(1).Range("A1").Resize(UBound(myAry, 1), UBound(myAry, 2) + 1) = myAry
　　MsgBox ("完了しました")
End Sub

あくまでサンプルなどで条件の解釈が違っていたら直してくださいね。

No.1 回答者： cametan_42 回答日時： 2020/08/04 15:59

さてさて。

最初にこの問題見た時思い浮かんだのは、

「これはVBAの案件と言うより、DOSコマンドの案件じゃないの?」

と言う事でした。
ちょっと尖ったOS弄ってる層だと皆そう考えます。VBAを書ける/書けないは関係なく、明らかにOSに備え付けられた(筈の)コマンドで操作した方が楽そうな問題です。つまり、

「特定の文字列を含んだファイルをピックアップする」

なんてのは、「プログラムを書いて」そのプログラムにやらせるよりOSが得意(な筈)な仕事なんですよね。
んで、VBA素人の僕はこう考えたわけです。

「VBA書いた事がない僕でもVBAからDOSコマンド呼び出すくらい余裕で簡単に書けるでしょ。」



















簡単じゃなかった.......orz

VBAって聞きしに勝る劣悪なプログラミング言語・・・っつーか環境なのかな?でした。Visual Basic自体は知りませんが、間違いなくExcelに載ってるVBAは最悪の言語/言語環境の一つです。初めてExcelでVBA使ってみましたが、まぁ～、これほどストレス感じて何か書いたのは久しぶりです。
正直言うと、題意のプログラムくらいだったら、Python使ってOSのコマンド走らせてcsvファイルにまとめた方が早いと思います。csvファイルはExcelで開けてそっちの方で保存できるんで、題意のプログラムを「わざわざ使いづらい」VBAで仕上げんでもエエんちゃうの、って思ったのが「正直なトコ」です。それくらいVBAのプログラムを書く環境がツラかった。

ではまずは前提条件。その前提条件がちとややこしいんですが。
まず質問に提示されてるこの部分から。

> ・条件・
> .txtファイル
> 1つのフォルダに有り（サブフォルダなし）
> 約5000ファイル有り
> 「リンゴ」「みかん」「バナナ」を含むファイル（ファイル内に記載されているもの）

基本的に、「OSのコマンド」は1つのフォルダ内で、5000もあるテキストファイルの中身見ながら結果を返すのは造作もない筈なんですが・・・Windowsだとちと面倒な制限がある。それは次の事です。

・そのテキストファイルがShift-JISで保存されているのかUTF-8で保存されているのかで呼び出すコマンド(と言うかシェル自体が)違う

テキストファイルの文字コードは「ご自分で」お調べください。単純に言うと、「ワードパッドで保存したら」Shift-JIS、「メモ帳で保存したら」UTF-8になります。ここでは、そっちの環境がどうなってんのか知らないので、Shift-JISで保存したテキストエディタだと「仮定」しています。

で、仮にShift-JISで保存したテキストファイルだとすると、そのフォルダ内からDOS窓から例えば

findstr "リンゴ" *.txt

と打てばDOS窓に検索結果のリストが表示されるでしょう。

注: ちなみに、対象がUTF-8のファイルだったら、DOS窓ではなくってWindows PowerShellを呼び出し、該当のフォルダに移動して

select-string "リンゴ" *.txt

と打つ。テキストファイルの文字コードの保存形式によって、呼び出すコマンドプロンプトもコマンド名も全く異なるので注意する。従って、後述するプログラムの「OSのコマンド呼び出し」の部分も、テキストファイルの文字コードによっては差し替える必要がある。

このDOS窓でのコマンド実行の結果を利用してVBAでプログラムを書いていく、ってのがテなんですが・・・いやはやなんとも。

・ ExcelでVBAを書ける環境に持っていくのが難しい。こんな環境設定の難しさをフツーのExcelユーザーに求めるのは酷じゃないか?ハッキリ言ってC言語でのプログラミング環境を整えるより難しいだろう(基本的に、メモ帳で書いて端末でコンパイラ走らせるだけだし)。ただし、ExcelでVBAプログラミングを覚えてから他の言語を学ぶ際、Excelよりもラクな事に気づくだろうからその辺は利点なのか?
・ Excelでコードを編集する際、文の途中で「あ、あっちを修正せな」って気づき、カーソルを移動すると「コンパイルエラー」が出てきて編集が一々中断する。エディタは「編集の為のツール」なのに、結果編集が邪魔される。バカなの?そもそもエディタとコンパイラがシームレスだ、ってのに問題があり、VBAでのコード編集のメンド臭さの90％はこのエディタのクソ仕様に由来する。
・ 一々デバッガが立ち上がる割にはデバッガが何言ってるのかサッパリ情報が少ない。
・個々の行で用いた変数等、プログラムを書いてる間、中身を確かめようがない。VBAはどうやら、原理的にはインタプリタではなく、コンパイラだからだ。しかもExcelと密接に繋がってるから、部分的にコンパイルして結果を確かめる、なんつーのは難しいので、暗中模索しながらコードを書かないとならない。
・ 【表示】から【ローカルウィンドウ】を表示して、デバッガを追っかけるのが吉と判明。しかしながらやっぱデバッグ結果は要領を得ない。
・ ハマった大きな理由その1: Excel VBAは自身が載ってるExcelファイルが保存されたフォルダをカレントディレクトリと認識していない。これが大きなクソ仕様だった。従って、プログラム内で、特定のディレクトリに移動してやるように指定しないといけない。慣れたVBAプログラマだったら、ユーザーに問い合わせのボックスを表示して誘導する事も可能だろうが、スクリプト言語に大きく負けてる原因のその1がこれで、利便性を大きく損なっている。
・ ハマった大きな理由その2: Excel VBAの配列の仕様がワケワカメ。っつーか、配列の要素はC言語風の0から参照されるのか、BASIC/PASCAL風の1から参照されるのかハッキリしろ。「隠し」で0番を作るな。For Eachが怖くて使えなくなるだろ。BASIC風に1からやってたらsplit関数では0に要素があります、とかこえーんだよ。いい加減にしろ。

大体、VBAが「ダメだ」って言われる理由ってこんなトコじゃなかろうか・・・実感しました。プログラム書くのに貧弱な環境＋「なんだその仕様?」ってなるとアタマに来る人が多いだろ、当然。

さて、「プログラムからコマンドラインを呼び出し・・・」と言う方向性さえ定めれば(Excel VBA以外で書くなら)簡単なワケで、そうすると「VBAだったら基本的にはどうすればいいのか」さえ分かれば書けるわけで(希望的観測)、次のページにまずは則ってみました。

【これでばっちり】VBAでコマンドプロンプトを使う方法:
https://www.sejuku.net/blog/89852

んで、VBAのクソ仕様と格闘した結果出来たのが次です。

Sub prog1()
Dim WSH As New IWshRuntimeLibrary.WshShell
Dim Result As WshExec
Dim Lines() As String
Dim Line As Variant
Dim elm() As String
Dim col As Integer

Set WSH = CreateObject("WScript.Shell")


Dim keywords(2) As String

　keywords(0) = "リンゴ": keywords(1) = "みかん": keywords(2) = "バナナ"

Dim keyword As Variant
Dim i As Integer

col = 1

ChDir "C:\\foo\\bar\\baz\\hoge\\" ' ここはファイルが保存されているフォルダの完全パスを記述

For Each keyword In keywords()

　Set Result = WSH.Exec("%ComSpec% /c" & " findstr " & keyword & " *.txt") ' ここでDOSコマンド実行

　If (Result.Status = WshFailed) Then ' DOSコマンド実行が失敗したら脱出
　　　Exit Sub
　End If

　Do While Result.Status = 0
　　DoEvents
　Loop

　Lines = Split(Result.StdOut.ReadAll, vbCrLf) ' DOSコマンドが実行した結果(標準出力)を分捕ってきて分割する

　For Each Line In Lines
　　If (Not Line = "") Then ' どうやらLinesのケツに改行文字が付いてるらしいんで、そこを省く
　　　　elm = Split(Line, ":")
　　　　Cells(col, 1) = elm(0)
　　　　Cells(col, 2) = keyword
　　　　col = col + 1
　　End If
　Next
Next

Set Result = Nothing
Set WSH = Nothing
End Sub

まあ、こんなトコじゃないですかね。