Extract some lines from a .cfg/.txt file and paste it into an excel

[stinkzor]

Hey guys,

I got a hard one and I dont know how to start this.
I have 150+ folders with 2-3 .cfg/.txt files (CS:GO config files) and I want to extract specific lines from them.
So I need a script to search the 2-3 files for lines like:
cl_crosshairalpha
cl_crosshaircolor
cl_bob_lower_amt
cl_bobamt_lat

In the files you can find the value for this lines and I need the whole line incl. value in an excel. It can happen that an file does not have on of the obove lines. In this case I dont wont an output.
This would be the output of the attached sample file:
cl_crosshairalpha "255"
cl_crosshaircolor "4"
cl_bob_lower_amt "21"
cl_bobamt_lat "0.33"

Is there a way to do this task or do I have to do it manually?
Note: I had to convert the file into a .txt file because i cant upload a .cfg file!

Thanks
stinkzor

[Marc L]

Hey,

attach at least another text file and the expected workbook result according to both samples text files
and an accurate explanation in order to process the folders or I could only post a demonstration to read a single text file …

[stinkzor]

Hey Marc,

you are right, my explanation was not accurate enough.
Please find attached the config.txt (please keep in mind that its originally a .cfg file but I cant upload a .cfg file) and a sample.xlsx.

I think the biggest problem with scraping all data from all files/folders at once will fail because the file is always called config.cfg. The folder has a specific name...

So I think the best is to do it file/folder per file/folder. What do you think?

In the sample.xlsx from row 2-15 you can find the line I want it to search for, Ideally in 3 categories.

As result I need each category in a separate cell, separating it with a semicolon followed by a space ("; ").

You would safe me so much time if you could help me out.
Thanks a lot.
stinkzor

[Marc L]

As result I need each category in a separate cell, separating it with a semicolon followed by a space ("; ").

Is this your final target ? A bit weird according to Excel purpose …

And you forgot to describe your folder structure, any root one ?

[Artik]

I prepared the following code before you published the last post. The layout of the output is a bit different than what you wanted. But try it.

Sub ReadConfigFiles()
    Dim sFolder     As String
    Dim varrFiles   As Variant
    Dim sFilter     As String
    Dim vSub        As Variant
    Dim varrSearch  As Variant
    Dim strFileContent As String
    Dim i           As Long
    Dim j           As Long
    Dim k           As Long
    Dim varrResult  As Variant
    Dim strSearch   As String
    Dim lLenFolder  As Long
    Dim FSO         As Object

    vSub = True
    
    'file type
    sFilter = "*.cfg"    'or "*.txt"
    
    'root folder
    sFolder = "C:\Program Files (x86)\Steam\userdata\"
    
    'searched attributes
    varrSearch = Split("cl_crosshairalpha,cl_crosshaircolor,cl_bob_lower_amt,cl_bobamt_lat", ",")


    Set FSO = CreateObject("Scripting.FileSystemObject")

    Call ListFiles(sFolder, varrFiles, FSO, sFilter, vSub)

    If Not IsEmpty(varrFiles) Then
        ReDim varrResult(1 To 2, 1 To UBound(varrFiles) * (UBound(varrSearch) + 1))

        k = 1
        lLenFolder = Len(sFolder)

        For i = 1 To UBound(varrFiles)
            strFileContent = TakeFromFile(CStr(varrFiles(i)))
            For j = 0 To UBound(varrSearch)
                strSearch = vbNullString

                strSearch = GetLineText(strFileContent, CStr(varrSearch(j)))

                If Len(strSearch) > 0 Then
                    varrResult(1, k) = Mid(varrFiles(i), lLenFolder)
                    varrResult(2, k) = strSearch
                    k = k + 1
                End If
            Next j
        Next i

        varrResult = TransposeIt(varrResult)
        
        ActiveWorkbook.Worksheets.Add

        With ActiveSheet
            .Range("A1:B1").Value = Array("Root: " & sFolder, "Files: " & sFilter)
            .Range("A2:B2").Resize(UBound(varrResult)).Value = varrResult
            .Columns("A:B").AutoFit
        End With
    End If
End Sub



Sub ListFiles(ByVal sFolder As String, ByRef varrFiles As Variant, Optional FSO As Object, _
              Optional sFilter As String, Optional vSubFolders As Variant)

    '---------------------------------------------------------------------------------------
    ' Procedure : ListFiles
    ' DateTime  : 08.12.2013
    ' Author    : Artik
    ' Purpose   : Procedura listująca nazwy plików (pełne odwołanie) we wskazananym folderze.
    '             Procedura działa rekurencyjnie.
    '---------------------------------------------------------------------------------------
    '

    Dim fsoFolder   As Object
    Dim fsoSubFolders As Object
    Dim fsoSubFolder As Object
    Dim fsoFile     As Object
    Dim i           As Long
    Dim IsNotFSO    As Boolean
    Dim objFSO      As Object

    Set objFSO = FSO

    If objFSO Is Nothing Then
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        IsNotFSO = True
    End If


    If objFSO.FolderExists(sFolder) Then
        Set fsoFolder = objFSO.GetFolder(sFolder)
        Set fsoSubFolders = fsoFolder.SubFolders

        If fsoSubFolders.Count > 0 Then

            If IsMissing(vSubFolders) Then
                If MsgBox("Should you include sub-folders?", _
                          vbQuestion + vbYesNo, _
                          "File list") = vbYes Then
                    vSubFolders = True
                Else
                    vSubFolders = False
                End If
            End If

        Else
            vSubFolders = False

        End If    'fsoSubFolders.Count > 0


        If Len(sFilter) = 0 Then sFilter = "*.*"


        For Each fsoFile In fsoFolder.Files
            Application.StatusBar = "Folder search: " & fsoFolder.Path

            If UCase(fsoFile.Name) Like UCase(sFilter) Then
                If IsEmpty(varrFiles) Then
                    ReDim varrFiles(1 To 1)
                End If

                i = UBound(varrFiles)

                If IsEmpty(varrFiles(i)) Then
                    i = i - 1
                End If

                i = i + 1

                ReDim Preserve varrFiles(1 To i)

                varrFiles(i) = fsoFile.Path    'pełne odwołanie
                'varrFiles(i) = fsoFile.Name 'tylko nazwa pliku z rozszerzeniem

            End If    'UCase(fsoFile.Name) Like UCase(sFilter)

        Next fsoFile


        If vSubFolders Then
            For Each fsoSubFolder In fsoSubFolders
                Call ListFiles(fsoSubFolder.Path, varrFiles, objFSO, sFilter, True)
            Next fsoSubFolder
        End If    'vSubFolders = True

    End If    'objFSO.FolderExists(sFolder) = True

    Set fsoSubFolders = Nothing
    Set fsoFolder = Nothing
    If IsNotFSO Then
        Set objFSO = Nothing
    End If

    Application.StatusBar = False
End Sub



Function TakeFromFile(strFileName As String) As String
    Dim iFn         As Integer
    Dim strFileContent As String

    iFn = FreeFile

    Open strFileName For Input As #iFn
    strFileContent = Input(LOF(iFn), iFn)
    Close #iFn

    TakeFromFile = strFileContent
End Function



Function GetLineText(strText As String, strSearchText As String) As String
    Dim lPos1       As Long
    Dim lPos2       As Long

    lPos1 = InStr(1, strText, strSearchText)

    If lPos1 > 0 Then
        lPos2 = InStr(lPos1 + 1, strText, vbLf)

        GetLineText = Mid(strText, lPos1, lPos2 - lPos1)
    End If

End Function



Function TransposeIt(vData)
    Dim LBound2     As Long

    LBound2 = -1

    If IsArray(vData) Then
        ' test for 1D array
        On Error Resume Next
        LBound2 = UBound(vData, 2)
        On Error GoTo 0

        With CreateObject("New:{8BD21D20-EC42-11CE-9E0D-00AA006002F3}")
            .Column = vData

            If LBound2 = -1 Then
                ' for 1D, returning the Column will transpose and return 2D array
                TransposeIt = .Column
            Else
                ' for 2D array just return the List
                TransposeIt = .List
            End If
        End With

    End If
End Function

Artik

[jindon]

Select main folder when asked.

Sub test()
    Dim myDir As String, fn As String, myList, i As Long, ii As Long, iii As Long
    Dim a, b, x, y, e, n As Long, temp(), txt As String, flg As Boolean
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = "" Then Exit Sub
    myList = SearchFiles(myDir, Array("txt", "cfg"), 0, temp(), 1)
    If IsError(myList) Then MsgBox "No file": Exit Sub
    a = Sheets("tabelle1").Cells(1).CurrentRegion.Value
    ReDim b(1 To 50000, 1 To 3)
    For i = 1 To UBound(myList, 2)
        fn = myList(1, i) & "\" & myList(2, i)
        If FileLen(fn) Then
            txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
            For Each e In Array(vbCrLf, vbCr, vbLf)
                If InStr(txt, e) Then x = Split(txt, e): Exit For
            Next
            If IsArray(x) Then
                For ii = 1 To 3
                    For iii = 3 To UBound(a, 1)
                        If a(iii, ii) <> "" Then
                            y = Filter(x, a(iii, ii), 1)
                            If UBound(y) > -1 Then
                                If Not flg Then n = n + 1: flg = True
                                b(n, ii) = b(n, ii) & IIf(b(n, ii) <> "", "; ", "") & y(0)
                            End If
                        End If
                Next iii, ii
                x = Empty: flg = False
            End If
            x = Empty
        End If
    Next
    Sheets.Add.Cells(1).CurrentRegion.Resize(n, 3) = b
End Sub
 
Private Function SearchFiles(myDir As String, Ext, n As Long, myList(), _
        Optional SearchSub As Boolean = False) As Variant
    Dim FSO As Object, myFolder As Object, myFile As Object, e, flg As Boolean
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each myFile In FSO.GetFolder(myDir).Files
        Select Case myFile.Attributes
            Case 2, 4, 6, 34
            Case Else
                If Not myFile.Name Like "~$*" Then
                    If IsArray(Ext) Then
                        For Each e In Ext
                            If UCase$(myFile.Name) Like UCase$("*" & e) Then
                                flg = True: Exit For
                            End If
                        Next
                    Else
                        flg = UCase$(myFile.Name) Like UCase$("*" & Ext)
                    End If
                    If flg Then
                        n = n + 1
                        ReDim Preserve myList(1 To 2, 1 To n)
                        myList(1, n) = myDir
                        myList(2, n) = myFile.Name
                    End If
                End If
        End Select
    Next
    If SearchSub Then
        For Each myFolder In FSO.GetFolder(myDir).SubFolders
            SearchFiles = SearchFiles(myFolder.Path, Ext, _
            n, myList, SearchSub)
        Next
    End If
    SearchFiles = IIf(n > 0, myList, CVErr(xlErrRef))
End Function

[stinkzor]

wow, that works very well!! thank you!
As mentioned I got 100+ folders with 2-3 files in it. The files in that folders have all the same name but the folders are unique.
Is it possible to read all folders at once and sort the results, like in the sample attached?
Player1
result
Player2
result
Player3
result
etc...

[jindon]

You must have same list like in sample1.xlsx.
change

                        If a(iii, ii) <> "" Then
                            y = Filter(x, a(iii, ii), 1)
                            If UBound(y) > -1 Then
                                If Not flg Then n = n + 1: flg = True
                                b(n, ii) = b(n, ii) & IIf(b(n, ii) <> "", "; ", "") & y(0)
                            End If
                        End If

to

                        If a(iii, ii) <> "" Then
                            y = Filter(x, a(iii, ii), 1)
                            If UBound(y) > -1 Then
                                If Not flg Then
                                    n = n + 1: flg = True
                                    b(n, 1) = myList(1, i): n = n + 1
                                End If
                                b(n, ii) = b(n, ii) & IIf(b(n, ii) <> "", "; ", "") & y(0)
                            End If
                        End If

[stinkzor]

thank you for that quick reply!
I just tried it and get an runtime error "52":
filename or number wrong

I cant figure out whats wrong... could you have a look?

[jindon]

Can you read fn when you get debug mode?

You can see the value if you hover the cursor over variable "fn".

[Marc L]

According to your post #3 attachment with the post #7 expected layout a VBA demonstration for starters
to paste to the top of the worksheet module then, as without any clear explanation neither any answer to my question,
just amend in Demo1 procedure the root path within the codeline ImportFiles ThisWorkbook.Path & "\"
or just save the workbook in the root folder :

Dim F%, K(), R&, T$()

Sub ImportFiles(ByVal P$)
      Const N = "config.cfg"
        Dim B%, S$(), C%, V, D$
    If Dir(P & N) > "" Then
            B = 2
            Open P & N For Input As #F
            S = Split(Input(LOF(F), #F), vbLf)
            Close #F
        With Application
            For C = 1 To UBound(K)
                    V = Filter(.IfError(.Match(K(C), S, 0), False), False, False)
                If UBound(V) > -1 Then
                    If B Then T(R + 1, 1) = P: R = R + B: B = 0
                    T(R, C) = Join(.Index(S, V), "; ")
                End If
            Next
        End With
    End If
          S = Split("")
          D = Dir$(P, 16)
    While D > ""
          If Not D Like ".*" Then If (GetAttr(P & D) And 16) Then ReDim Preserve S(UBound(S) + 1): S(UBound(S)) = P & D & "\"
          D = Dir$
    Wend
        For Each V In S:  ImportFiles V:  Next
End Sub

Sub Demo1()
  Const L = 19
    Dim C%
        Cells(L, 1).CurrentRegion.Clear
    With [A1].CurrentRegion.Columns
            ReDim K(1 To .Count), T(1 To Rows.Count + 1 - L, 1 To .Count)
        For C = 1 To .Count
          K(C) = Filter(Evaluate(Replace("TRANSPOSE(IF(#>0,#&"" *""))", "#", .Cells(3, C).Resize(.Rows.Count - 2).Address)), False, False)
        Next
    End With
        F = FreeFile
        R = 0
        ImportFiles ThisWorkbook.Path & "\"
        If R Then Cells(L, 1).Resize(R, UBound(T, 2)).Value2 = T
        Erase K, T
End Sub 

► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

[jindon]

I'm just about go offline,
try replace "test" sub with

Sub test()
    Dim myDir As String, fn As String, myList, i As Long, ii As Long, iii As Long
    Dim a, b, x, y, e, n As Long, temp(), txt As String, flg As Boolean
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = "" Then Exit Sub
    myList = SearchFiles(myDir, Array("txt", "cfg"), 0, temp(), 1)
    If IsError(myList) Then MsgBox "No file": Exit Sub
    a = Sheets("tabelle1").Cells(1).CurrentRegion.Value
    ReDim b(1 To 50000, 1 To 3)
    For i = 1 To UBound(myList, 2)
        fn = myList(1, i) & "\" & myList(2, i): txt = "": x = Empty: flg = False
        On Error Resume Next
        txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
        On Error GoTo 0
        If txt <> "" Then
            For Each e In Array(vbCrLf, vbCr, vbLf)
                If InStr(txt, e) Then x = Split(txt, e): Exit For
            Next
            If IsArray(x) Then
                For ii = 1 To 3
                    For iii = 3 To UBound(a, 1)
                        If a(iii, ii) <> "" Then
                            y = Filter(x, a(iii, ii), 1)
                            If UBound(y) > -1 Then
                                If Not flg Then
                                    n = n + 1: flg = True
                                    b(n, 1) = myList(1, i): n = n + 1
                                End If
                                b(n, ii) = b(n, ii) & IIf(b(n, ii) <> "", "; ", "") & y(0)
                            End If
                        End If
                Next iii, ii
            End If
        End If
    Next
    Sheets.Add.Cells(1).CurrentRegion.Resize(n, 3) = b
End Sub