Extract string from multiple files using vba

[matto666]

I need to extract a data from a set of text files inside a folder. I tried several times without success, I hope that someone can help me.

All the files I have to read are inside the folder C:/test. The data I need to extract from text file is located after a key word.

The data should be placed in an excel file (every data copied from a single text file inside a different cell).

Is there someone that can help me? I tried (with success) to write the macro for one single file, but I don't know how I can do it for all the files in my folder!!

[mancubus]

try:

Sub run_macro_on_all_files()
    
    Dim strPath As String
    Dim strFiles As String
    
    strPath = "C:\test\"
    If Not Dir(strPath & "*.txt") = "" Then 'test for existence of txt files
        strFiles = Dir(strPath & "*.txt")
        Do Until strFiles = ""
            'paste your code here
            '...
            '...
            '...
            strFiles = Dir
        Loop
    End If 

End Sub

[matto666]

Hi, and thanks for your help

you can see my code below. I don't receive any errors, but my excel file is blank..

Sub run_macro_on_all_files()

Dim strPath As String
Dim strFiles As String
Dim cella

strPath = "C:\prova\"
If Not Dir(strPath & "*.txt") = "" Then 'test for existence of txt files
strFiles = Dir(strPath & "*.txt")
Do Until strFiles = ""

Open strFiles For Input As #1

Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
'Close file
Close #1
ReadBRTLuminance = InStr(text, "Read BRT Luminance")
ActiveCell.Offset(cella, 1).Value = Mid(text, ReadBRTLuminance + 31, 9)
cella = cella + 1


strFiles = Dir
Loop
End If

End Sub

[mancubus]

you are welcome.

please use code tags when posting your code to the thread. When you click # button in Quick Reply code tags (without spaces) will be inserted.

[ CODE ]paste your code between these tags[ /CODE ]

you can find a number of examples about reading a txt file content here at VBAX.

below worked for me:

Sub ReadTextFile_FindString_WriteToCell()

    Dim strPath As String, strFiles As String, strTxtFile As String    Dim strToFind As String, strToWrite As String
    Dim cella As Long
    
    strPath = "C:\prova\"
    strToFind = "Read BRT Luminance"
    cella = 0
    
    If Dir(strPath & "*.txt") = "" Then 'test for existence of txt files
        MsgBox "No txt files in the directory: " & strPath
        Exit Sub
    End If
        
    strFiles = Dir(strPath & "*.txt")
    Do Until strFiles = ""
        strTxtFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(strPath & strFiles).ReadAll
        strToWrite = Mid(strTxtFile, InStr(strTxtFile, strToFind) + 31, 9)
        ActiveCell.Offset(cella, 1).Value = strToWrite
        cella = cella + 1
        strFiles = Dir
    Loop


End Sub

[matto666]

IT WORKS!!!!!!!!!!!!!!!!!!!

Thanks, you're great!

[mancubus]

you are welcome.

mark the thread from Thread Tools dropdown which is above the first message for future references..