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

Question

这个问题在这里已经有了答案:





Loop through files in a folder using VBA?

(6 个回答)


3年前关闭。




我有一个包含数百个文本文件的文件夹，我需要从中解析一些行。然后需要将这些行粘贴到继续按顺序向下的 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)

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