如何通过包含数百个.txt文件的文件夹运行宏

时间:2019-05-22 02:43:21

标签: vba visual-studio

我有一个包含数百个.txt文件的文件夹,我需要从中解析一些行。然后需要将这些行粘贴到excel表格中,然后依次向下。这是我第一次尝试使用vba,但是我设法从一个文件中提取想要的文本并将其粘贴到excel工作表中,但是我一直无法在整个文件夹中连续运行宏,并不断将解析的文本行添加到Excel工作表。抱歉,这很粗糙,但这是我第一次尝试宏编写

我尝试使用Application.FileDialog(msoFileDialogFolderPicker)调用包含所有.txt文件的文件夹。然后我用

打开所需的文件
MyFile = Dir(MyFolder & "\", vbReadOnly)

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

这是我的代码的基本部分

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

将objFSO当作对象     将objFolder作为对象变暗

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)

'Report Out宏完成     消息框“已完成”

'Close Text File
     Close TextFile

i = i + 1
Next

End Sub

这给了我想要的结果,但是我必须遍历每个单独的文件,这很耗时。我宁愿让它循环,尽管整个文件夹会从每个文件中提取信息,并将提取的文本添加到excel表中,并继续沿每一行向下移动,任何帮助将不胜感激

1 个答案:

答案 0 :(得分: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)

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