使用 VBA Excel 在文本文件中显示搜索文本

Question

I am new to VB and have a problem.

I have a text file named data.txt . It has 1 lines in it

IamanewstudentHeisanewstudentthestudentinthisclassisveryfunnythisuniversityhave300studentthestudentisveryfriendlywithnewcommer

I write a script which reads this text file and look for the string such as "stutent" and print all the "student" we can found in cell in excel (B1,C1,D1....). In this example we have 5 "student". It will display in cell B1,C1,D1,E1,F1 in sheet.

I tried till this point but it just give me only one "student" not five.

Sub SearchTextFile()
Const strFileName = "C:\data.txt"
Const strSearch = "student"
Dim strLine As String
Dim f As Integer
Dim lngLine As Long
Dim blnFound As Boolean
Dim lPosition As Long
f = FreeFile
Open strFileName For Input As #f
Do While Not EOF(f)
    lngLine = lngLine + 1
    Line Input #f, strLine
    If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then
        blnFound = True
        lPosition = InStr(1, strLine, strSearch, vbTextCompare)            
        MsgBox "Search string found" & strSearch, vbInformation
        Exit Do
    End If
Loop
Close #f
If Not blnFound Then
    MsgBox "Search string not found", vbInformation
End If
End Sub

Answer 1

I would use RegEx to count the number of occurences in the line with the following function

Function noInStr(line As String, pattern As String) As Long

    Dim regEx As Object, matches As Object
    Set regEx = CreateObject("vbscript.regexp")
    With regEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .pattern = pattern
    End With

    Set matches = regEx.Execute(line)

    noInStr = matches.count

End Function

You could use it in your code like that

Sub SearchTextFile()
    Const strFileName = "C:\data.txt"
    Const strSearch = "student"
    Dim strLine As String
    Dim f As Integer
    Dim lngLine As Long
    Dim blnFound As Boolean
    Dim lPosition As Long
    f = FreeFile
    Open strFileName For Input As #f
    Do While Not EOF(f)
        lngLine = lngLine + 1
        Line Input #f, strLine
        Dim count As Long
        count = noInStr(strLine, strSearch)
        If count > 0 Then
            blnFound = True
            MsgBox "Search string found " & count & "- times: " & strSearch, vbInformation
            Exit Do
        End If
    Loop
    Close #f
    If Not blnFound Then
        MsgBox "Search string not found", vbInformation
    End If
End Sub

If you also need the positions you could retrieve them with RegEx, too.

Update : This is how you could also retrieve the positions

Function colInStr(line As String, pattern As String) As Collection

    Dim regEx As Object, matches As Object
    Set regEx = CreateObject("vbscript.regexp")

    With regEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .pattern = pattern
    End With

    Set matches = regEx.Execute(line)
    Dim col As New Collection

    Dim i As Long
    For i = 0 To matches.count - 1
        col.Add matches(i).FirstIndex
    Next i
    Set colInStr = col

End Function

You also need to modify your code, below only the relevant part

Dim count As Long, col As Collection
Set col = colInStr(strLine, strSearch)
count = col.count
If count > 0 Then
    blnFound = True
    MsgBox "Search string found " & count & "- times: " & strSearch, vbInformation
    Exit Do
End If

The positions are stored in the collection.

Answer 2

This will help find all the student strings and their right positions. I have commented my changes. I run the test using your file

Sub SearchTextFile()

    Const strFileName = "C:\data.txt"
    Const strSearch = "student"
    Const strReplaceSearch = "tneduts"
    Dim strLine As String
    Dim f As Integer
    Dim lngLine As Long
    Dim blnFound As Boolean
    Dim lPosition As Long
    f = FreeFile
    Open strFileName For Input As #f
    Do While Not EOF(f)
        lngLine = lngLine + 1
        Line Input #f, strLine
        '' For every line retreived, loop for all occurences of student
        Do While (InStr(1, strLine, strSearch, vbBinaryCompare) > 0)
            blnFound = True
            lPosition = InStr(1, strLine, strSearch, vbTextCompare)
            MsgBox "Search string found" & strSearch, vbInformation
            '' remove the string student found and search for the next, we replace the word student with tneduts, that helps us keep the lPosition right
            strLine = Replace(strLine, strSearch, strReplaceSearch, 1, 1)
       Loop
    Loop
    Close #f
    If Not blnFound Then
        MsgBox "Search string not found", vbInformation
    End If

End Sub