Search code examples
excelvbscriptautomationexport-to-excel

LIsting all the text files in a folder and writing information to excel sheet


There are certain text files in a folder, i.e, file1.txt ; file2.txt; ... Also, there is an array of strings which can be stored as studs(i) in VBScript. My objective is to verify if each string (studs(i)) is present in each of the text file (fileN.txt) and write the information to an excel sheet with the strings elements in the rows and filenames(file1, file2, file3,....) in the columns. I need a Vbscript which automates this process. Any help is greatly appreciated


Solution

  • See if this helps

    • execute findstr command
    • capture result in System.Collections.ArrayList
    • result can then be stored in excel

    Code

    Function findFilesThatContain(searchText, filePath)
        Set DataList = CreateObject _
        ("System.Collections.ArrayList")
        Set objShell = WScript.CreateObject("WScript.Shell")
        Set objExecObject = objShell.Exec("findstr /M """ & searchText & """ " & filePath)
        Do While Not objExecObject.StdOut.AtEndOfStream
            fileLoc = objExecObject.StdOut.ReadLine()
            'Wscript.Echo searchText&","&fileLoc      
            DataList.Add fileLoc
        Loop
        Set findFilesThatContain = DataList
    End Function
    
    Sub saveToExcel(searchText, searchPath, strExcelPath)
        Set objExcel = CreateObject("Excel.Application")
        If (Err.Number <> 0) Then
            On Error GoTo 0
            Wscript.Echo "Excel application not found."
            Wscript.Quit
        End If
        objExcel.Workbooks.Add
        Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
        objSheet.Name = "Search Result"
        Dim i,j
        j = 1
        For Each searchText in searchTexts
            Dim files
            Set files = findFilesThatContain (searchText, searchPath)
            i = 1
            objSheet.Cells(i, j).Value = searchText
            For Each path in files
                Wscript.Echo searchText&","&path
                i = i + 1
                objSheet.Cells(i, j).Value = path
            Next
            j = j + 1
        Next
        objSheet.Range("1:1").Font.Bold = True
        objExcel.ActiveWorkbook.SaveAs strExcelPath, 56
        objExcel.ActiveWorkbook.Close
        objExcel.Application.Quit
    End Sub
    Dim strExcelPath
    strExcelPath = "c:\test.xls"
    Dim searchPath 
    searchPath = "E:\bin\bat\*.bat"
    Dim searchTexts(2)
    searchTexts(0)="pushd"
    searchTexts(1)="if"
    saveToExcel searchText, searchPath, strExcelPath
    

    output

    table