如何通过包含数百个文本文件的文件夹运行宏[重复]

Question

我有一个包含数百个文本文件的文件夹，我需要从中解析一些行。然后需要将这些行粘贴到继续按顺序向下的 Excel 工作表中。这是我第一次尝试 VBA，但我设法从一个文件中提取我想要的文本并将其粘贴到 Excel 工作表中，但我无法在整个文件夹中连续运行宏并不断将解析的文本行添加到Excel 工作表。对不起，如果这很粗糙，但这是我第一次尝试宏编写

我尝试使用Application.FileDialog(msoFileDialogFolderPicker) 调用包含我所有文本文件的文件夹。然后我打开了我想要的文件：

MyFile = Dir(MyFolder & "\", vbReadOnly)

然后我尝试使用 Do Loop 在每个文件中运行宏，但尽管完成了宏，但它没有返回任何值，它只是替换了之前获得的结果。

这是我的代码的基本部分：

Sub read()
'PURPOSE: Send All Data From Text File To A String Variable

    Dim TextFile As Integer
    Dim FilePath As String
    Dim FileContent As String
    Dim MyFolder As String, MyFile As String

    'Opens a file dialog box for user to select a folder
    With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
       .Show
       MyFolder = .SelectedItems(1)
       Err.Clear
    End With

    'File Path of Text File
    MyFile = Dir(MyFolder & "\", vbReadOnly)

    'Determine the next file number available for use by the FileOpen function
    TextFile = FreeFile

    'Open the text file
    Open MyFile For Input As #1

    'Store file content inside a variable
    Do Until EOF(1)
        Line Input #1, textline
        Text = Text & textline
    Loop

    Close #1
        
    Dim objFSO As Object
    Dim objFolder As Object

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.getFolder(MyFolder)
       
    Dim fls As Object
    Dim i As Integer
    i = 1
       
    For Each fls In objFolder.Files
    'find required data from txt file

        starttime = InStr(Text, "+start=")
        endtime = InStr(Text, "+end=")
        so = InStr(Text, "+so=")
        engineer = InStr(Text, "+engineer=")
        account = InStr(Text, "+account=")
        incident = InStr(Text, "+number=")
        machine = InStr(Text, "+machine=")
        down = InStr(Text, "+down=")
        nextrow = Cells(Rows.Count, "A").End(xlUp).Row + 1

        'label headers for txt data
        Range("A1").Value = "       start time   "
        Range("B1").Value = "       end time   "
        Range("C1").Value = "   SO   "
        Range("D1").Value = "       Total Time    "
        Range("E1").Value = "   Engineer       "
        Range("F1").Value = "   Account"
        Range("G1").Value = "   Incident"
        Range("H1").Value = "   Machine"
        Range("I1").Value = "   down"

        'paste obtained txt data into excel cells
        Range("A2" & i).Value = Mid(Text, starttime + 7, 16)
        Range("B2").Value = Mid(Text, endtime + 5, 16)
        Range("C2").Value = Mid(Text, so + 4, 8)
        Range("E2").Value = Mid(Text, engineer + 10, 4)
        Range("F2").Value = Mid(Text, account + 9, 6)
        Range("G2").Value = Mid(Text, incident + 8, 4)
        Range("H2").Value = Mid(Text, machine + 9, 4)
        Range("I2").Value = Mid(Text, down + 6, 9)

       'Report Out macro finished
        MsgBox "      Finished        "

        'Close Text File
         Close TextFile
          
        i = i + 1
    Next
    
End Sub

这给了我想要的结果，但我必须浏览每个单独的文件，这很耗时。我宁愿让它循环遍历整个文件夹，从每个文件中提取信息，并将提取的文本添加到 Excel 工作表中，继续向下延伸每一行。任何帮助将不胜感激。

Answer 1

您可以使用以下代码循环浏览文件夹中的所有文件。根据需要修改。

'First you will need to declare an object

Dim objFSO As Object
Dim objFolder As Object

'then set this object to the address you received in first part of your code 

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getFolder(MyFolder) 

'Now create a new object for files in that folder and apply the for loop as below

Dim fls As Object
Dim i As Integer
i = 1
For Each fls In objFolder.Files

'----- Your Code to perform on Each file
Range("A" & i+1).value ' Change all accordingly

i = i + 1
Next

这应该做的工作！

编辑 ------------ 您必须更改所有字段

Range("A" & i + 1).Value = Mid(Text, starttime + 7, 16)
Range("B" & i + 1).Value = Mid(Text, endtime + 5, 16)
Range("C" & i + 1).Value = Mid(Text, so + 4, 8)
Range("E" & i + 1).Value = Mid(Text, engineer + 10, 4)
Range("F" & i + 1).Value = Mid(Text, account + 9, 6)
Range("G" & i + 1).Value = Mid(Text, incident + 8, 4)
Range("H" & i + 1).Value = Mid(Text, machine + 9, 4)
Range("I" & i + 1).Value = Mid(Text, down + 6, 9)

编辑打开文件：

您必须在循环中打开每个文件：

 MyFile = Dir(MyFolder & "\" fls.Name, vbReadOnly)

然后按照您的方式提取文本。但这必须在循环中完成。这样每个文件都会重复该过程。