关于读取txt文件并搜索的问题

[kneyoo]

请问各位，如何读取在同一个文件夹中的若干个txt文件，并对文件内容按照关键字进行搜索，最终列表出符合条件的txt文件名？

忘指教

谢谢

[OracleRoob]

参考：

读取文本文件的函数如下:
Function ReadTXT(file1 As String) As String '读文本文件
On Error GoTo err1
Dim fn As Integer
Dim ss As String, S As String

fn = FreeFile()
Open file1 For Input As #fn
Do While Not EOF(fn)

Line Input #fn, S
If ss = "" Then
ss = S
Else
ss = ss + Chr(13) + Chr(10) + S
End If
Loop
Close #fn
ReadTXT = ss '返回读到的文本

Exit Function
err1:
Close #fn
End Function

[OracleRoob]

--用SQL语句读取txt文件

Select * From [Text;Database=D:\].Test.txt')

[OracleRoob]

--参考：显示所有的文件。如
call bianli("c:")
将列出c盘上所有的文件。

function bianli(path)
set fso=createobject("scripting.filesystemobject")
on error resume next
set objFolder=fso.GetFolder(path)

set objSubFolders=objFolder.Subfolders
for each objSubFolder in objSubFolders
if right(path,1)<>"\" then
nowpath=path + "\" + objSubFolder.name
else
nowpath=path + objSubFolder.name
end if
Response.Write nowpath
set objFiles=objSubFolder.Files
for each objFile in objFiles
Response.Write "<br>"
Response.Write objFile.name
next
Response.Write "<hr>"
if objSubFolder.attributes<>16 then bianli(nowpath)
'bianli(nowpath)
next
Response.Write path1
for each objFile1 in objFolder.Files
Response.Write "<br>"
Response.Write objFile1.name
next
Response.Write "<hr>"
set objFolder=nothing
set objSubFolders=nothing
set fso=nothing
end function

[OracleRoob]

完整的代码需要自己去写。

参考上述代码可以帮助你实现。

[wwwwb]

1、TXT文件格式及内容；
2、假设在目录中没有子目录：
Dim df As New FileSystemObject
'创建一个Folder对象
Set MyFolder = df.GetFolder("d:\zz")
'循环显示其中文件
For Each thing In MyFolder.Files
MsgBox thing.Name
If InStr(thing.Name, ".txt") > 0 Then
If ty(thing.Name) Then
MsgBox thing.Name & "ok"
End If
End If
Next

Function ty(ByVal mc As String) As Boolean
Open "你的路径" & mc For Input As #1 ' 打开输出文件。
Do While Not EOF(1)
Line Input #1, fg
If Len(fg) <> 0 Then
If InStr(fg, "你查找的内容，出可以用参数") > 0 Then
ty = True
Exit Do
End If
End If
Loop
Close #1
End Function

[wwwwb]

如有子目录，用wangtiecheng的代码进行递归，再调用我的函数即可

[wwwwb]

于FSO对象包含在Scripting 类型库 (Scrrun.Dll)中，所以在使用前首先需要在在工程中引用这个文件，单击“工程”，“引用”，然后在“引用”对话框中选中“Microsoft Scripting Runtime”前的复选框，然后单击“确定”。

[wwwwb]

If InStr(fg, "你查找的内容，出可以用参数") > 0 Then->
If InStr(fg, "你查找的内容，也可以用参数") > 0 Then

在VFP下，用ADIR就可以解决了。

[wwwwb]

Set MyFolder = df.GetFolder("d:\zz") 可以设置为你的目录
没有看到TXT文件格式及内容，用循环方法速度慢一些，如有规律，可以用
SQL语句，速度快一些。

[wwwwb]

wangtiecheng的遍历文件代码有点问题
bianli("d:") or bianli("d:\temp")

Function bianli(Path) As Integer
Dim fso As New FileSystemObject
Set objFolder = fso.GetFolder(Path)
For Each objFile In objFolder.Files
K = K + 1
Next
For Each objFolder In objFolder.SubFolders
J = J + 1
bianli (objFolder)
Next
Set objFolder = Nothing
Set objSubFolders = Nothing
Set fso = Nothing
bianli = K
End Function

[wwwwb]

bianli("d:") or bianli("d:\temp")

Function bianli(Path) As Integer
Dim fso As New FileSystemObject
Set objFolder = fso.GetFolder(Path)
For Each objFile In objFolder.Files
If InStr(objFile.Name, ".txt") > 0 Then
If ty(thing.Name) Then
MsgBox thing.Name & "ok"
End If
End If
Next
For Each objFolder In objFolder.SubFolders
J = J + 1
bianli (objFolder)
Next
Set objFolder = Nothing
Set objSubFolders = Nothing
Set fso = Nothing
bianli = K
End Function

[wwwwb]

MsgBox thing.Name & "ok"->MsgBox objFile.Name.Name & "ok"

[manrenmanren]

牛！值得学习！

[wwwwb]

If ty(objFile.Name) Then
MsgBox objFile.Name & "ok"
End If

[wwwwb]

完整代码：
bianli("你的目录") 注意：格式 d:\ or c:\ or d:\123

Function ty(ByVal mc As String) As Boolean
Open mc For Input As #1
Do While Not EOF(1)
Line Input #1, fg
If Len(fg) <> 0 Then
If InStr(fg, "你的内容") > 0 Then
ty = True
Exit Do
End If
End If
Loop
Close #1
End Function

Function bianli(Path) As Integer
Dim fso As New FileSystemObject
Dim objFolder As Folder
Set objFolder = fso.GetFolder(Path)
For Each objFile In objFolder.Files
If InStr(LCase(objFile.Name), ".txt") > 0 Then
If ty(objFolder.Path & "\" & objFile.Name) Then
MsgBox objFolder.Path & "\" & objFile.Name & " ok "
你处理内容
End If
End If
Next
For Each objFolder In objFolder.SubFolders
bianli (objFolder)
Next
Set objFolder = Nothing
Set objSubFolders = Nothing
Set fso = Nothing
End Function

[vbman2003]

楼主不知道跑那儿去了？二个版主如此热心，发完贴子3天了，他却没吭气一声! 真过份