Question

我在几个文件夹中有大量文本文件，我需要每个文本文件中的第14行，我想知道是否还有这样做？

目前我有以下脚本设置，我在第一个工作表中将文件夹目录输入到单元格A19中，这将返回目录中所有文件的文件路径。然后，我希望利用上述文件路径从每个文本文件的第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

这是我被卡住的地方。我想阅读每个文本文件并获取每个文本文件的第14行，仅此而已。

Answer 1

您的ReadTxtFiles子程序似乎在读取数据，然后对它没有任何作用。也许它在你没有发布的代码部分做了些什么。

然而，只读取14行是相对简单的，然后最后读入的是您想要的记录：

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"
        '...
        '...

Answer 2

这有帮助吗？要进行测试，请在设置路径和文件名后运行过程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

您可以提供您需要的循环路径（Pn）和文件名（Fn）。让代码添加扩展名.txt。在函数调用中指定所需的行号，例如指定第14行的TextLine(Ffn, 14)。

Answer 3

自从我完成VBA以来，已经很长一段时间，但要找到事物的第n次迭代，请使用MOD。 This is explains how to use it你可以在网上找到很多其他的例子。

从多个文件夹中的多个文本文件中读取特定行

3 个答案: