对于每个单独的文件名，如何从多个文本文件中提取数据？

Question

I need one value from multiple text files. Those text files are stored with a 5-digit filename in a folder(Around 1000 files) and I would like to create a macro, which scans this folder for a subset of files and then extract an individual Euro value.

I got the extraction part going, but I'm not able to loop this process through different file names yet as I'm fairly new to VBA.

Sub ExtractData()
    Dim myFile As String, text As String, textline As String, Data As Integer, filename As String
    Dim myFolder As String

    myFolder = "C:\Folder\"
    filename = Range("A1").Value & ".txt"
    myFile = "C:\Folder\" & filename & ""

    Open myFile For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline
    Loop
    Close #1

    Data = InStr(text, "Euro")
    Range("B1").Value = Mid(text, Data + 6, 4)

End Sub

I would highly appreciate it if someone would point me in the right direction. Greetings

Answer 1

You may use Scripting.FileSystemObject to iterate the files in the target folder, use the Like operator to validate the file name and then get the value from each file as usual.

This should work:

Sub ExtractData()
    Dim folderPath As String, filePath As String
    Dim textline As String, data As Integer
    folderPath = "C:\Folder\"

    Dim oFso As Object: Set oFso = CreateObject("Scripting.FileSystemObject")
    Dim oFolder As Object: Set oFolder = oFso.GetFolder(folderPath)
    Dim oFiles As Object: Set oFiles = oFolder.Files
    Dim oFile As Object

    Dim counter As Integer
    For Each oFile In oFiles
        If Not oFile.Name Like "#####.txt" Then GoTo ContinueFor

        data = 0
        counter = counter + 1
        Range("A" & counter).Value = oFile.Name
        filePath = folderPath & oFile.Name

        Open filePath For Input As #1
            Do Until EOF(1) Or data > 0
                Line Input #1, textline
                data = InStr(textline, "Euro")
            Loop
        Close #1

        If data > 0 Then Range("B" & counter).Value = Mid(textline, data + 6, 4)
ContinueFor:
    Next
End Sub

This will extract the target value from the first line that contains the word "Euro". If the value that you're trying to extract is not in the same line, you can read the whole text (similar to what you did originally) and then extract the value you want:

Dim allText As String
' ...
' ...

Open filePath For Input As #1
    allText = Input(LOF(1), 1)
Close #1

data = InStr(allText, "Euro")
If data > 0 Then Range("B" & counter).Value = Mid(allText, data + 6, 4)

There are probably better ways but it all depends on the structure of your file (which you haven't shown). For example, if the target value is in the next line and you know its position in that line, you could use the original code above to read the line that contains the word "Euro", read the next line, and then extract the value.