Блог

Я разрабатываю функцию VBA для сбора определенных данных из различных текстовых файлов. В настоящее время функция идеально работает с одним файлом. Однако я хотел бы расширить его для зацикливания нескольких текстовых файлов.

 Sub onlinecharges()
    
Workbooks.Add

Dim myFolder As String, mtext As String, textline As String, po_charges As Integer
myFolder = Application.GetOpenFilename()
    
Open myFolder For Input As #1
    
Do Until EOF(1)
Line Input #1, textline
text = text amp; textline
Loop
    
Close #1

po_charges = InStr(text, "NET CHARGES")

ActiveWorkbook.Sheets(1).Cells(2, 1).Value = Dir(myFolder)
ActiveWorkbook.Sheets(1).Cells(2, 2).Value = Abs(Mid(text, po_charges   88, 8))
    
End Sub
 

В настоящее время имя файла указывается в A2, конкретные данные-в B2.
Результатом моего желания являются имена файлов от A2 до Ai, конкретные данные от B2 до Bi.
Итак, как я могу добавить цикл для сканирования нескольких выбранных текстовых файлов?
Очень признателен! Спасибо!

В этом решении он позволяет выбирать несколько текстовых файлов.

 Sub LoopAllSelectedTextFilesInAFolder()
    Dim rw As Integer: rw = 2
    
    ' Loop through all files in a folder
    Dim Filename As Variant
    Filename = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), *.txt", Title:="Select file(s)", MultiSelect:=True)
    
    ' Check if Cancel button was pressed
    If Not IsArray(Filename) Then
        MsgBox " No files selected!", vbInformation
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    ' Loop through selected files
    Dim i As Integer
    For i = 1 To UBound(Filename)
        Open Filename(i) For Input As #1
            Do Until EOF(1)
                Line Input #1, textline
                Text = Text amp; textline
            Loop
        Close #1
        
        ' Write filename amp; Text
        ActiveWorkbook.Sheets(1).Cells(rw, 1).Value = Filename
        ActiveWorkbook.Sheets(1).Cells(rw, 2).Value = Text
        
        ' next row
        rw = rw   1
        
        ' Clear Text
        Text = ""
    Next i
    
    Application.ScreenUpdating = True
End Sub