Vba 如何在包含数百个.txt文件的文件夹中运行宏

我有一个包含数百个.txt文件的文件夹，我需要从中解析一些行。然后需要将这些行按顺序粘贴到excel工作表中。这是我第一次尝试vba，但我成功地从一个文件中提取了所需的文本并将其粘贴到excel工作表中，但我仍然无法在整个文件夹中连续运行宏，并将解析后的文本行连续添加到excel工作表中。抱歉，如果这是粗糙的，但这是我第一次尝试宏编写

我尝试使用Application.FileDialog（msoFileDialogFolderPicker）调用包含所有.txt文件的文件夹。然后我打开了我想要的文件

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

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

这是我的代码的基本部分

Sub read()

'用途：将文本文件中的所有数据发送到字符串变量

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

'文本文件的文件路径 MyFile=Dir（MyFolder&“\”，vbReadOnly）

'确定下一个可供FileOpen函数使用的文件号 TextFile=FreeFile

'打开文本文件 打开MyFile作为#1输入

'将文件内容存储在变量中

Do Until EOF(1)
    Line Input #1, textline
    Text = Text & textline
Loop

Close #1

作为对象的Dim objFSO 将文件夹变暗为对象

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

'从txt文件中查找所需数据

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

'标记txt数据的标题

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"

'将获取的txt数据粘贴到excel单元格中

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)

'报告输出宏已完成 MsgBox“已完成”

---

这给了我想要的结果，但我必须仔细检查每个文件，这很耗时。我宁愿让它在整个文件夹中循环，从每个文件中提取信息，并将提取的文本添加到excel工作表中，继续沿着每一行进行操作。如果您能提供任何帮助，我将不胜感激。

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

'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)

---

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

谢谢您的输入！如果您遇到任何错误，我将尝试使用此注释。它现在正在每个文件中循环，但不会使用每个文件中的新值更新excel工作表。有什么建议吗？我怀疑这是因为我试图为每个值指定一个单元格范围。是的，您将不得不循环粘贴所需的值。因此，简而言之，如果要将值从第一行粘贴到excel中，并将代码更改为“Range”（“a:”&i）.value），则必须声明一个整数i，并在同一循环中为其赋值1。另外，不要忘记在“下一步”之前将i的值加上1，这样在下一次迭代中，代码会将值粘贴到excel的下一行。我已经修改了代码。希望它能解决你的问题。

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