すべてのフォルダとサブフォルダ内のテキストファイルを検索するvbaコード

Question

誰でも共有ドライブのすべてのフォルダとサブフォルダのテキストファイル内にユーザ入力キーワードを検索するvbaコードで助けてください。また、キーワードがテキストファイルにある場合は、テキストファイルを含むフォルダ名とパスを返します。

私は、ユーザがキーワードを入力することができるウィンドウ形式を有し、ユーザが検索ボタンを押すと、上記の機能を実行しなければならない。

例： ユーザーが「ビジネス」のようなキーワードを検索する場合、共有ドライブ内のすべてのフォルダとサブフォルダ内のすべてのテキストファイルで「ビジネス」を検索する必要があります。見つかった場合は、フォルダ名とそのファイルを含むパスを返します。出力の 例

フォルダ名：ABC フォルダのパス：C：ABC

は、誰もがよろしくお願いしますコード で私を助けてください\オフィス\。

ここに私のコードは

enter code here 

公開サブFindFilesと（ある）

Shell32.Shell

点心などのMicrosoftのシェルコントロールとオートメーション '

薄暗いSHL「に追加しました参照は' fol As Shell32.Folder

Dim row As Long

セットSHL =新Shell32.Shell

セットFOL = shl.Namespace（ "C：\ Users \ユーザー"）

行= 1

ProcessFolderRecursivelyのFOL、行

終了Sub

Private Sub ProcessFolderRecursively（Shell32.Folder、ByRef行As Long）

薄暗い項目はShell32.Folder

としてShell32.FolderItem

薄暗いfol2ないようFOL何物でもありませんその後

For Each item In fol.Items 

    If item.IsFolder Then 

     Set fol2 = item.GetFolder 

     ProcessFolderRecursively fol2, row 

    Else 

     Sheets("Sheet2").Select 

      Cells(row, 1) = item.path 

      row = row + 1 
    End If 

Next 

エンド

の場合End Subの

Answer 1

場合、私はこれを信じます答えはあなたの質問に答えるのに役立ちます。 VBAでUsing a wildcard to open an excel workbook

することはできませんファイルを開く*のようなワイルドカード文字。ファイル名と場所が変わらない場合は、すべてのファイル名のリストをコンパイルする必要があります。

リスト内の各ファイルを開き、検索されたキーワードに対してfind（）関数を使ってテキスト文書をスキャンすることができます。見つかった場合はファイル名を返します。

あなたが直面している問題は、ファイルの場所をコンパイルしてリストを作成することですが、回答はありません。残りは簡単です。

Answer 2

次のコードは、

Option Explicit 
Public Function RecursiveDir(colFiles As Collection, _ 
          strFolder As String, _ 
          strFileSpec As String, _ 
          bIncludeSubfolders As Boolean) 

Dim strTemp As String 
Dim colFolders As New Collection 
Dim vFolderName As Variant 

    'Add files in strFolder matching strFileSpec to colFiles 
    strFolder = TrailingSlash(strFolder) 
    strTemp = Dir(strFolder & strFileSpec) 
    Do While strTemp <> vbNullString 
     colFiles.Add strFolder & strTemp 
     strTemp = Dir 
    Loop 

    If bIncludeSubfolders Then 
     'Fill colFolders with list of subdirectories of strFolder 
     strTemp = Dir(strFolder, vbDirectory) 
     Do While strTemp <> vbNullString 
      If (strTemp <> ".") And (strTemp <> "..") Then 
       If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then 
        colFolders.Add strTemp 
       End If 
      End If 
      strTemp = Dir 
     Loop 

     'Call RecursiveDir for each subfolder in colFolders 
     For Each vFolderName In colFolders 
      Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True) 
     Next vFolderName 
    End If 

End Function 

Public Function TrailingSlash(strFolder As String) As String 
    If Len(strFolder) > 0 Then 
     If Right(strFolder, 1) = "\" Then 
      TrailingSlash = strFolder 
     Else 
      TrailingSlash = strFolder & "\" 
     End If 
    End If 
End Function 

Function SearchTxtFile(ByVal txtFileName As String, txtSearch As String) As Boolean 

Dim fso As Object 'Scripting.FileSystemObject 
Dim myFile As Object 'Scripting.TextStream  
Dim ReadAllTextFile As Variant 

    Set fso = CreateObject("Scripting.FileSystemObject") 
    ' Open the file for input. 
    Set myFile = fso.OpenTextFile(txtFileName, ForReading) 

    ' Read from the file. 
    If myFile.AtEndOfStream Then 
     ReadAllTextFile = "" 
    Else 
     ReadAllTextFile = myFile.ReadAll 
    End If 

    If InStr(1, ReadAllTextFile, txtSearch, vbTextCompare) > 0 Then 
     SearchTxtFile = True 
    Else 
     SearchTxtFile = False 
    End If 

End Function 
Sub TestSearchFiles() 

Dim colFiles As New Collection 
Const txtPattern = "Business" 
Const YOUR_START_DIR = "Your Dir" 

    RecursiveDir colFiles, YOUR_START_DIR, "*.TXT", True 

    Dim vFile As Variant 
    For Each vFile In colFiles 
     If SearchTxtFile(vFile, txtPattern) Then 
      Debug.Print vFile 
     End If 
    Next vFile 

End Sub 

EDIT次のコードは、完全なパス

Function GetDirectory(path) 
    GetDirectory = Left(path, InStrRev(path, "\")) 
End Function 

Chhange

に上記のコードでのDebug.Printラインのパス名を与える助けることができます

Debug.Print vFile, GetDirectory(vFile) 

それはあなたが望むものですか？

EDIT2：あなたを助けるために私たちを助けて

Sub TestSearchFiles() 

Dim colFiles As New Collection 
Dim txtPattern() As Variant 
Const YOUR_START_DIR = "Your directory here" 

    txtPattern = Array("Pattern1", "Pattern2") 
    RecursiveDir colFiles, YOUR_START_DIR, "*.TXT", True 

    Dim vFile As Variant 
    For Each vFile In colFiles 
     If SearchTxtFile(vFile, txtPattern) Then 
      Debug.Print vFile, GetDirectory(vFile) 
     End If 
    Next vFile 

End Sub