VBA判断txt文件中的内容

Sub 读文件()
    On Error GoTo errh
    Dim fNum As Integer, Length1 As Long, w1 As String, Isopen As Boolean
    fNum = FreeFile()
    Open FullNames For Binary As #fNum
    Isopen = True
    Length1 = LOF(fNum)
    w1 = Space$(Length1)
    Seek #fNum, 1
    Get #fNum, , w1
    MsgBox w1
    Close
    Readbinary = w1
errh:
    If Isopen Then Close
    MsgBox Err.Description
End Sub

该代码一次读入文件到变量w1中，由于你没有提供文本文件以及怎样整理后写入EXCEL，其他过程都做不了。

Sub 读取文件文件()
    'On Error Resume Next
    Dim FileOpen, x%, sr$, n%
    
    FileOpen = Application.GetOpenFilename("文本文件,*.txt", , "选择文件", , True)
    If TypeName(FileOpen) = "Boolean" Then Exit Sub
    x = 1
    While x <= UBound(FileOpen)
    
        sr = getstr(FileOpen(x))
        
        If InStr(sr, "apple") > 0 Then
            [A1].Offset(n) = sr
             n = n + 1
        End If
        x = x + 1
    Wend

End Sub

Function getstr(pFile As Variant) As String
    Dim hFile As Long
    Dim sFile As String '
    hFile = FreeFile
    Open pFile For Binary As hFile
    sFile = Space(LOF(hFile))
    Get #hFile, , sFile
    getstr = sFile
    Close
End Function