使用ADO Stream读取UTF-8日文文本并实现字符串匹配与行号获取

有一个存储含日文数据的UTF-8文本文件的文件夹，需要在这些文件中搜索特定字符串，找到匹配项后复制对应完整行及其行号（单个文件可能存在多个匹配）。由于FileSystemObject无法读取UTF-8数据，需采用ADO Stream，但不清楚如何逐行读取文件以使用类似ReadLine的方法，也不知道如何实现类似FSO中InStr(pos, s, FindThis, vbTextCompare)的搜索功能。

原测试代码：

Sub TestR_utf_8()
    Dim st As ADODB.Stream
    Dim sPathname As String, sText As String
    
    sPathname = "c:\tmp\test_utf-8.txt"
    
    ' create a stream object
    Set st = New ADODB.Stream
    
    ' set properties
    st.Charset = "utf-8"
    st.Type = adTypeText
    
    ' open the stream object and load the text
    st.Open
    st.LoadFromFile (sPathname)
    
    ' read 10 characters
    sText = st.ReadText
    
    ' display the characters read
    MsgBox sText
    
    st.Close
    Set st = Nothing
End Sub

实现步骤 #

1. 逐行读取ADO Stream #

ADO Stream的ReadText方法支持传入参数adReadLine来读取单行文本，同时可通过LineSeparator属性设置换行符（适配不同文件的换行格式，UTF-8文件常用adLF）。循环读取直到EOF为真即可遍历所有行。

2. 不区分大小写的字符串搜索 #

直接使用VBA内置的InStr函数，指定vbTextCompare参数即可实现不区分大小写的匹配，效果和FSO中的InStr(pos, s, FindThis, vbTextCompare)完全一致。

完整实现代码 #

Sub SearchUTF8FilesInFolder()
    Dim st As ADODB.Stream
    Dim folderPath As String, searchStr As String
    Dim fileName As String, lineText As String
    Dim lineNum As Long, matchCount As Long
    Dim result As String
    
    ' 替换为你的文件夹路径和目标搜索字符串
    folderPath = "C:\Your\Target\Folder\"
    searchStr = "要搜索的特定字符串"
    
    ' 统一文件夹路径格式
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    ' 遍历文件夹下所有txt文件
    fileName = Dir(folderPath & "*.txt")
    Do While fileName <> ""
        Set st = New ADODB.Stream
        With st
            .Charset = "utf-8"
            .Type = adTypeText
            .LineSeparator = adLF ' 若文件用Windows风格CRLF，可改为adCRLF
            .Open
            .LoadFromFile folderPath & fileName
        End With
        
        lineNum = 0
        result = result & "文件：" & fileName & vbCrLf
        
        ' 逐行读取并搜索匹配
        Do Until st.EOF
            lineNum = lineNum + 1
            lineText = st.ReadText(adReadLine)
            
            If InStr(1, lineText, searchStr, vbTextCompare) > 0 Then
                matchCount = matchCount + 1
                result = result & "行号：" & lineNum & " 内容：" & lineText & vbCrLf
            End If
        Loop
        
        st.Close
        Set st = Nothing
        fileName = Dir()
    Loop
    
    ' 展示搜索结果
    If matchCount > 0 Then
        MsgBox "找到" & matchCount & "个匹配项：" & vbCrLf & vbCrLf & result
    Else
        MsgBox "未找到任何匹配项"
    End If
End Sub

注意事项 #

• 需在VBA编辑器的「工具-引用」中勾选Microsoft ActiveX Data Objects x.x Library（推荐选较新版本）
• 根据实际文件的换行格式调整LineSeparator：
  • adLF：适配Unix/Linux风格换行
  • adCRLF：适配Windows风格换行
  • adCR：适配旧Mac风格换行

内容的提问来源于stack exchange，提问作者Gaurav