Excel VBA macro find Текст в .doc-файлах

Question

Я хочу написать макрос, который может найти файлы, имеющие имя XXXX_TestSummary, примерно в 100 папках и искать в этих файлах слово «Failed». Макрос должен возвращать имя файла, которое содержит слово, сбой в тексте или excel.

Я застреваю, так как могу просто найти имена файлов в папке. Ниже приведен код

Sub MainList() 

    'Updateby20150706 
    Set folder = Application.FileDialog(msoFileDialogFolderPicker) 
    If folder.Show <> -1 Then Exit Sub 
    xDir = folder.SelectedItems(1) 
    Call ListFilesInFolder(xDir, True) 

End Sub 

Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean) 

    Dim xFileSystemObject As Object 
    Dim xFolder As Object 
    Dim xSubFolder As Object 
    Dim xFile As Object 
    Dim rowIndex As Long 
    Set xFileSystemObject = CreateObject("Scripting.FileSystemObject") 
    Set xFolder = xFileSystemObject.GetFolder(xFolderName) 
    rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1 
    For Each xFile In xFolder.Files 
     Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Name 
     rowIndex = rowIndex + 1 
    Next xFile 
    If xIsSubfolders Then 
     For Each xSubFolder In xFolder.SubFolders 
     ListFilesInFolder xSubFolder.path, True 
     Next xSubFolder 
    End If 
    Set xFile = Nothing 
    Set xFolder = Nothing 
    Set xFileSystemObject = Nothing 

End Sub 

Function GetFileOwner(ByVal xPath As String, ByVal xName As String) 

    Dim xFolder As Object 
    Dim xFolderItem As Object 
    Dim xShell As Object 
    xName = StrConv(xName, vbUnicode) 
    xPath = StrConv(xPath, vbUnicode) 
    Set xShell = CreateObject("Shell.Application") 
    Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode)) 
    If Not xFolder Is Nothing Then 
     Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode)) 
    End If 
    If Not xFolderItem Is Nothing Then 
     GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 8) 
    Else 
     GetFileOwner = "" 
    End If 
    Set xShell = Nothing 
    Set xFolder = Nothing 
    Set xFolderItem = Nothing 

End Function 

Может ли кто-нибудь помочь исправить это?

Answer 1

Если вы собираетесь с указанным кодом, вам нужно будет добавить некоторый код в вашем цикле:

For Each xFile In xFolder.Files 
    Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Name 
    (ADD CODE HERE) 
    rowIndex = rowIndex + 1 
Next xFile 

или, в качестве альтернативы, можно добавить, если заявление к верхней части этого цикла, чтобы проверить, xFile.Name содержит «Failed»:

For Each xFile In xFolder.Files 
    If InStr(xFile.Name, "Failed") Then 
     Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Name 
     rowIndex = rowIndex + 1 
    End If 
Next xFile 

Таким образом, вы бы только список файлов, которые содержат «Failed» в тексте их имени.