Question

我试图使用Microsoft Scripting Runtime打开文本文件，查找特定的文本字符串，然后复制该行及其下的所有内容，直到文件结尾并将其写入excel。我不需要按列设置格式，只希望它按文件中的原样显示。下面是我尝试使用的代码，但我认为我犯了一些错误。

Sub readFile()
    Dim sFileName As String

    sFileName = "C:\Users\Jamie\Desktop\REPORT.txt"
    With New Scripting.FileSystemObject
        With .OpenTextFile(sFileName, ForWriting)
            If Mid(sFileName, 3, 6) = "PALLET" Then
                .ReadAll
                Do Until .AtEndOfStream
                Loop
            End If
        End With
    End With
End Sub

这里是REPORT.TXT的示例

RANDOM DATA THAT'S NOT NEEDEDRANDOM DATA THAT'S NOT NEEDED
RANDOM DATA THAT'S NOT NEEDED
RANDOM DATA THAT'S NOT NEEDED
RANDOM DATA THAT'S NOT NEEDEDRANDOM DATA THAT'S NOT NEEDEDRANDOM DATA THAT'S NOT NEEDED
RANDOM DATA THAT'S NOT NEEDED



     PALLET INFORMATION
=================================
UNDER 5 HRS     5
6 to 10 HRS     20
11 to 15 HRS    45
OVER 20 HRS     12
=================================

Report Generated on 2/12/19 by IBM z/OS JBL.9897992

Answer 1

在这里，您的代码经过重构以实现所需的功能。它主要说明如何使用FileSystemObject来读取文本文件。我怀疑一旦掌握了文件数据，您将需要进行更改，以使将数据轻松放入工作表中。

版本1-如果文件足够小，可以读入单个字符串

Sub readFile()
    Dim sFileName As String
    Dim FileData As String
    Dim PalletData As String
    Dim idx As Long
    Dim LocationToPlaceData As Range

    sFileName = "C:\Data\Temp\Report.txt" '"C:\Users\Jamie\Desktop\REPORT.txt"
    With New Scripting.FileSystemObject
        With .OpenTextFile(sFileName, ForReading)
            FileData = .ReadAll
            .Close
        End With
    End With
    idx = InStr(FileData, "PALLET")
    If idx > 0 Then
        PalletData = Mid$(FileData, idx)
        'get location to place data - update to suit your needs
        Set LocationToPlaceData = ActiveSheet.Range("A1")

        'Place Data in a single cell
        LocationToPlaceData = PalletData
    End If
End Sub

版本2-如果文件太大而无法读取为单个字符串。

Sub readFile2()
    Dim sFileName As String
    Dim FileLine As String
    Dim PalletData As String
    Dim idx As Long
    Dim LocationToPlaceData As Range

    sFileName = "C:\Data\Temp\Report.txt" '"C:\Users\Jamie\Desktop\REPORT.txt"
    With New Scripting.FileSystemObject
        With .OpenTextFile(sFileName, ForReading)
            Do Until .AtEndOfStream
                FileLine = .ReadLine
                idx = InStr(FileLine, "PALLET")
                If idx > 0 Then
                    PalletData = Mid$(FileLine, idx)
                    Do Until .AtEndOfStream
                        PalletData = PalletData & vbCrLf & .ReadLine
                    Loop
                End If
            Loop
            .Close
        End With
    End With

    'get location to place data - update to suit your needs
    Set LocationToPlaceData = ActiveSheet.Range("A1")

    'Place Data in a single cell
    LocationToPlaceData = PalletData
End Sub

VBA从特定字符串读取文件到文件结尾

1 个答案: