Search specific word in text file and write to excel

[Ehtisham Ali]

Hi guys,

I have a requirement and code as well but it requires some modification.

I have more than 500 text files containing nearly same text, and a keyword/s which I need to search in each file and export it into a excel cell. Need to parse all files one by one and search for the word.

I am attaching the sample text file for your reference.
Keyword1: System image file is "flash:c3845-advipservicesk9-mz.124-15.T3.bin"
Keyword2: Processor board ID FHK1205F2ZX
in combination.

Would be great if we can export "System image file" in colA and respective "Processor board ID" in colB. And where ever system image file or board ID not found row remains blank.

My Solution:
I have compiled all 500 files into one single file and pasted the text in a word document, then run the below mentioned MACRO.

Limitation of this solution is that we can search for 1 keyword at a time, so later we get puzzled which System Image is related to which Board ID.

Option Explicit

Sub FindWordCopySentence()
    Dim appExcel As Object
    Dim objSheet As Object
    Dim aRange As Range
    Dim intRowCount As Integer
    intRowCount = 1
    Set aRange = ActiveDocument.Range
    With aRange.Find
        Do
            .Text = "shall" ' the word I am looking for
            .Execute
            If .Found Then
                aRange.Expand Unit:=wdSentence
                aRange.Copy
                aRange.Collapse wdCollapseEnd
                If objSheet Is Nothing Then
                    Set appExcel = CreateObject("Excel.Application")
                     'Change the file path to match the location of your test.xls
                    Set objSheet = appExcel.workbooks.Open("C:\temp\test.xls").Sheets("Sheet1")
                    intRowCount = 1
                End If
                objSheet.Cells(intRowCount, 1).Select
                objSheet.Paste
                intRowCount = intRowCount + 1
            End If
        Loop While .Found
    End With
    If Not objSheet Is Nothing Then
        appExcel.workbooks(1).Close True
        appExcel.Quit
        Set objSheet = Nothing
        Set appExcel = Nothing
    End If
    Set aRange = Nothing
End Sub

Please suggest a better solution as this is not helping.

 

[Marc L]

Hi !

"Bad" code : it is not a good idea to open another Excel instance !
Easy way is to directly read text files !

Join a workbook with a desired result worksheet
according to your text file attachment …
​

 

[Chihiro]

Sample using FSO. You'll probably want to add another layer for checking all files in folder and loop through it, as well as set variable to store file name itself.

Sub Test()
Const Read = 1
Dim FSO As Object, FileChecked As Object
Dim strTmp As String
Dim strPos As Integer, strPos2 As Integer
Dim x As Variant
Dim nRow As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set FileChecked = FSO.OpenTextFile("C:\Test\Test.txt", Read)


Do Until FileChecked.AtEndOfStream
    strTmp = FileChecked.ReadLine
    If Len(strTmp) > 0 Then
        strPos = InStr(1, strTmp, "System image file is", vbTextCompare)
        strPos2 = InStr(1, strTmp, "Processor board ID", vbTextCompare)
        If strPos > 0 Then
            nRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            x = Split(strTmp, " ")
            Cells(nRow, 1) = Trim(Replace(x(UBound(x)), Chr(34), ""))
        ElseIf strPos2 > 0 Then
            nRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
            x = Split(strTmp, " ")
            Cells(nRow, 2) = Trim(x(UBound(x)))
        End If
    End If
Loop

FileChecked.Close

End Sub

 

[Ehtisham Ali]

Sample using FSO. You'll probably want to add another layer for checking all files in folder and loop through it, as well as set variable to store file name itself.

Sub Test()
Const Read = 1
Dim FSO As Object, FileChecked As Object
Dim strTmp As String
Dim strPos As Integer, strPos2 As Integer
Dim x As Variant
Dim nRow As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set FileChecked = FSO.OpenTextFile("C:\Test\Test.txt", Read)


Do Until FileChecked.AtEndOfStream
    strTmp = FileChecked.ReadLine
    If Len(strTmp) > 0 Then
        strPos = InStr(1, strTmp, "System image file is", vbTextCompare)
        strPos2 = InStr(1, strTmp, "Processor board ID", vbTextCompare)
        If strPos > 0 Then
            nRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            x = Split(strTmp, " ")
            Cells(nRow, 1) = Trim(Replace(x(UBound(x)), Chr(34), ""))
        ElseIf strPos2 > 0 Then
            nRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
            x = Split(strTmp, " ")
            Cells(nRow, 2) = Trim(x(UBound(x)))
        End If
    End If
Loop

FileChecked.Close

End Sub

Hi Your code is working fine but we have a few exceptions to handle.

In case when "System image file" is not available with respect to "Processor Board ID" we need to leave that cell blank. This logic should also be followed when "Processor board ID" is not available for "System image file".

Otherwise later the result is wrong because the data shifts up-down in cells, and hence we will not get "System image file" corresponding to "Processor board ID"

I am attaching a complete file for you to test.

 

[shrivallabha]

See if below code helps:
1. It will prompt you to select folder.
2. It loop through all "Text files" in that folder.

Sub ProcessTextFiles()
Const strFirstCrit As String = "System image file is" '\\ Define search criteria
Const strSeconCrit As String = "Processor board ID"  '\\ in these constants
Dim strFolderPath As String
Dim objFSO As Object, objFile As Object
Dim varContent
Dim lngCnt As Long

'\\ Prompt for selecting folder
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Title = "Select Text File Folder"
    .ButtonName = "Select"
    .Show
    If .SelectedItems.Count = 1 Then
        strFolderPath = .SelectedItems(1)
    Else
        '\\ Exit if user doesn't select folder
        MsgBox "No Folder Selected!", vbInformation
        Exit Sub
    End If
End With

lngCnt = 2                                                '\\ Report row
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(strFolderPath).Files  '\\ Loop through all files in the folder
    If objFile.Type = "Text Document" Then '\\ Open only Text files
        varContent = Split(objFSO.OpenTextFile(objFile.Path, 1).ReadAll, vbCrLf)
        Cells(lngCnt, "A").Value = CStr(Trim(Replace(Join(Filter(varContent, strFirstCrit, True, vbTextCompare)), strFirstCrit, "", 1, -1, vbTextCompare)))
        Cells(lngCnt, "B").Value = CStr(Trim(Replace(Join(Filter(varContent, strSeconCrit, True, vbTextCompare)), strSeconCrit, "", 1, -1, vbTextCompare)))
        Cells(lngCnt, "C").Value = objFile.Path
        lngCnt = lngCnt + 1
    End If
Next

End Sub

 

[Marc L]

Limitation of this solution is that we can search for 1 keyword at a time, so later we get puzzled which System Image is related to which Board ID.

No, the limitation comes only from the author of the code
or the person who thinked about its conception !
​