Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10136 / 76734 ←次へ | 前へ→

【72150】Re:テキストファイルの検索
発言  kanabun  - 12/6/8(金) 13:59 -

引用なし
パスワード
   速いのは、すべておまかせの Findコマンドだとおもうので、
この例を紹介します。
結果はシートに吐き出しますので、対象シートをアクティブにして、
下の
>  v = FindText("D:\(Data)", "*.txt", "あいう")
の部分を、
FindText(検索パス, 検索ファイル名(ワイルドカード可), 検索文字列)
のようにそちらの環境に合わせて修正して試してみてください。

Sub Findtest()
  Dim v
  Cells.ClearContents
  v = FindText("D:\(Data)", "*.txt", "あいう")
  v = Split(v, vbCrLf)
  Cells(1).Resize(UBound(v) + 1).Value = Application.Transpose(v)
End Sub

'テキストファイル内の検索
Private Function FindText(LookIn$, Filename$, What$) As String
  Dim tmpPath As String
  Dim sCmd As String
  Dim ko As Long
  Dim ff() As String
 
  If Right$(LookIn, 1) <> "\" Then LookIn = LookIn & "\"
  LookIn = LookIn & Filename
  tmpPath = Environ$("Temp") & "\Find.tmp" '作業用ファイル名
  sCmd = "FIND /n """ & What & """ " & LookIn & " > " & tmpPath
  'Debug.Print sCmd
  With CreateObject("WScript.Shell")
    ko = .Run("CMD /C " & sCmd, 7, True) 'Findコマンド実行
  End With

  If FileLen(tmpPath) < 1 Then '該当ファイルがなかったときの処理
    FindText = Split("")
    Exit Function
  End If
  Dim io As Integer
  Dim buf() As Byte
  io = FreeFile()
  Open tmpPath For Binary As io 'ファイルリスト取得
   ReDim buf(1 To LOF(io))
   Get #io, , buf
  Close io
  Kill tmpPath
  
  FindText = StrConv(buf, vbUnicode)
End Function

ただ、この方式ですと、
> ---------- D:\(DATA)\CB-ABC.TXT
> "[1]あいうえお    1234.5    2004-9-14"
>
> ---------- D:\(DATA)\CONCATEABC.TXT
>
> ---------- D:\(DATA)\MIDあいう.TXT
> [1]あいう
>
> ---------- D:\(DATA)\TEMP1234.TXT
のように、見つからなかったファイル名も表示されています。
[1]は行番号です。
検索でヒットしたファイルだけ表示したいなら、出力ファイルを編集するか、
Dirで抽出した*.Txtファイルを順に開いて、自前で検索するとか、
方法を変えないといけないですね
3 hits

【72148】テキストファイルの検索 ぬうゆう 12/6/8(金) 12:04 質問
【72149】Re:テキストファイルの検索 kanabun 12/6/8(金) 13:36 発言
【72150】Re:テキストファイルの検索 kanabun 12/6/8(金) 13:59 発言
【72151】Re:テキストファイルの検索 kanabun 12/6/8(金) 17:12 発言

10136 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free