从多个文件夹中的多个文本文件读取特定的行
我有几个文件夹内的大量文本文件，我需要从每个文本文件的第14行，我想知道是否有反正这样做？
目前我有下面的脚本设置，在第一个工作表中的单元格A19中input文件夹目录，并返回目录中所有文件的文件path。 然后我想利用上述文件path从每个文本文件的第14行获取信息。 这是我的代码到目前为止：
Private Sub CommandButton1_Click() 'Call the recursive function ListAllFiles ThisWorkbook.Sheets(1).Range("A19").Value, ThisWorkbook.Sheets(2).Cells(1, 1) ReadTxtFiles MsgBox "Task Completed" End Sub Private Sub ListAllFiles(root As String, targetCell As Range) Dim objFSO As Object, objFolder As Object, objSubfolder As Object, objFile As Object Dim i As Integer, Target_Path As String 'Create an instance of the FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'Get the folder object Set objFolder = objFSO.GetFolder(root) 'loops through each file in the directory and prints their names and path For Each objFile In objFolder.Files 'print file name targetCell.Value = objFile.Name 'print file path targetCell.Offset(, 1).Value = objFile.Path 'print file type 'targetCell.Offset(, 2).Value = objFile.Type 'print file date created 'targetCell.Offset(, 3).Value = objFile.DateCreated 'print file date last accessed 'targetCell.Offset(, 4).Value = objFile.DateLastAccessed 'print file date last modified 'targetCell.Offset(, 5).Value = objFile.DateLastModified Set targetCell = targetCell.Offset(1) Next objFile ' Recursively call the function for subfolders For Each objSubfolder In objFolder.SubFolders ListAllFiles objSubfolder.Path, targetCell Next objSubfolder End Sub
Private Sub ReadTxtFiles() 'Dim start As Date 'start = Now Dim oFSO As Object Set oFSO = CreateObject("Scripting.FileSystemObject") Dim oFS As Object '''''Assign the Workbook File Name along with its Path '''''Change path of the Target File name Dim v As Variant, filepath As String For Each v In Worksheets("Sheet2").Columns("B").SpecialCells(xlCellTypeConstants) filepath = v.Value Debug.Print filepath Dim arr(100000) As String Dim i As Long i = 0 If oFSO.FileExists(filepath) Then On Error GoTo Err Set oFS = oFSO.OpenTextFile(filepath) Do While Not oFS.AtEndOfStream arr(i) = oFS.ReadLine i = i + 1 Loop oFS.Close Else MsgBox "The file path is invalid.", vbCritical, vbNullString Exit Sub End If
这是我卡住的地方。 我想阅读每个文本文件，并得到每一个的第十四行，没有什么更多。
您的ReadTxtFiles子程序似乎读取数据，然后不做任何事情。 也许它在你没有发布的代码中做了一些事情。
然而，只读14行是相对直接的，然后上一次读入的是你想要的logging：
Private Sub ReadTxtFiles() 'Dim start As Date 'start = Now Dim oFSO As Object Set oFSO = CreateObject("Scripting.FileSystemObject") Dim oFS As Object '''''Assign the Workbook File Name along with its Path '''''Change path of the Target File name Dim v As Variant, filepath As String For Each v In Worksheets("Sheet2").Columns("B").SpecialCells(xlCellTypeConstants) filepath = v.Value Debug.Print filepath Dim rec As String Dim i As Long i = 0 rec = "" If oFSO.FileExists(filepath) Then On Error GoTo Err Set oFS = oFSO.OpenTextFile(filepath) Do While Not oFS.AtEndOfStream rec = oFS.ReadLine i = i + 1 If i = 14 Then Exit Do Loop oFS.Close Else MsgBox "The file path is invalid.", vbCritical, vbNullString Exit Sub End If 'Check we read 14 records If i < 14 Then MsgBox "Not enough records" Exit Sub End If 'do whatever you want with "rec" '... '...
这有帮助吗？ 要testing， TestGetLine在设置path和文件名后运行程序TestGetLine 。
Private Sub TestGetLine() ' 12 Apr 2017 Dim Pn As String ' Path Dim Fn As String ' File Dim Ffn As String Pn = "D:\My Documents\" Fn = "TextFile 14" Ffn = Pn & Fn & ".txt" If Len(Dir(Ffn)) Then Debug.Print TextLine(Ffn, 14) Else MsgBox Chr(34) & Fn & """ doesn't exist.", _ vbInformation, "Invalid file name" End If End Sub Private Function TextLine(ByVal Ffn As String, _ LineNum As Integer) As String ' 12 Apr 2017 Dim FileNum As Integer Dim Txt As String Dim Ln As Integer Close ' close any open text files FileNum = FreeFile Open Ffn For Input As #FileNum Do While Not EOF(1) ' Loop until end of file. Line Input #1, Txt Ln = Ln + 1 If Ln = LineNum Then Exit Do Loop If Ln < LineNum Then Txt = "File """ & Split(Ffn, "\")(UBound(Split(Ffn, "\"))) & _ """ has only " & Ln & " lines. No line was copied" End If Close TextLine = Txt End Function
您可以inputpath（ Pn ）和文件名称（ Fn ），在其中循环您需要。 让代码添加扩展名.txt 。 在函数调用中指定想要的行号，如指定行14的TextLine(Ffn, 14) 。
从VBA开始已经很长时间了，但是要find一个东西的第十个迭代，使用MOD。 这是解释如何使用它 ，还有很多其他的例子，你可以在网上find。