Как извлечь данные из нескольких текстовых файлов в отношении каждого отдельного имени файла?

Question

Мне нужно одно значение из нескольких текстовых файлов. Эти текстовые файлы хранятся в папке с 5-значным именем файла (около 1000 файлов), и я хотел бы создать макрос, который сканирует эту папку на предмет подмножества файлов, а затем извлекает отдельное значение в евро.

Я получил часть извлечения, но пока не могу пройти этот процесс по разным именам файлов, так как я довольно плохо знаком с 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

Буду очень признателен, если кто-нибудь укажет мне правильное направление. Привет

Answer 1

Вы можете использовать Scripting.FileSystemObject для итерации файлов в целевой папке, использовать оператор Like для проверки имени файла и затем получить значение из каждого файла какобычный.

Это должно работать:

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

Это извлечет целевое значение из первой строки, содержащей слово «Евро». Если вы пытаетесь извлечь значение , а не в той же строке, вы можете прочитать весь текст (аналогично тому, что вы делали изначально), а затем извлечь нужное значение:

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)

Возможно, есть лучшие способы, но все зависит от структуры вашего файла (который вы не показали). Например, если целевое значение находится в следующей строке, и вы знаете его положение в этой строке, вы можете использовать приведенный выше исходный код, чтобы прочитать строку, содержащую слово «Euro», прочитать следующую строку, а затем извлечь значение.