excel - 如何通过包含数百个文本文件的文件夹运行宏

Question

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

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

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

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

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

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)

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