vb6.0 读取某目录下的所有文本文件

2025-02-24 09:56:49
推荐回答(2个)
回答1:

'在窗体上画一个Text、一个Filebox
‘把text的multiline属性改成True
'把text的scrollbars属性改成3
'是只读属性,没办法,麻烦了
Option Explicit
Dim FPath As String
Dim i As Long, j As Long, temp As String, s As String
Private Sub Form_Load()
FPath = InputBox$("请输入路径!", "请输入路径名", "C:\aa\")
If Right(FPath, 1) <> "\" Then FPath = FPath & "\"
With File1
.Path = FPath
.Pattern = "*.txt"
.Visible = False
End With
With Text1
.Text = ""
End With
End Sub
Private Sub Form_Activate()
Print "正在读取文件,请稍候。。。"
For i = 1 To File1.ListCount
Open FPath & File1.List(i - 1) For Input As i
Do While Not (EOF(i))
Line Input #i, temp
s = s & vbCrLf & temp '读入数据
Loop
Close
s = s & vbCrLf
For j = 1 To 50
s = s & "-" '打印分割线
Next
s = s + vbCrLf

Next
Print "读取完毕!"
Text1.Text = s
For i = 0 To File1.ListCount - 1
Kill (FPath & File1.List(i)) '删除文件
Next
End Sub

’楼上的注意,只要读文本文件

回答2:

查找某目录下所有 文件 及 子文件夹
试一试不用 FileSystemObject 对象,只用基本控件的代码。
'例子需控件:Command1,List1,List2,File1,Dir1,都采用默认属性。
'例如,查找 C:\ ,带 '** 的语可修改

Dim ctFind As Boolean
Private Sub Form_Load()
Me.Caption = "查找所有文件及文件夹"
Command1.Caption = "查找"
List2.Visible = False: File1.Visible = False: Dir1.Visible = False
Label1.Caption = "就绪"
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Form_Resize()
Dim W As Long
On Error Resume Next
W = 720
List1.Move 0, 0, Me.ScaleWidth - W - 120, Me.ScaleHeight - 300
Command1.Move Me.ScaleWidth - W - 60, 300, W
Label1.Move 90, Me.ScaleHeight - 255, Screen.Width, 255
End Sub
Private Sub Command1_Click()
ctFind = Not ctFind
If ctFind Then
Command1.Caption = "取消"
Call FindDirFile("C:") '**查找 C:\ 下的所有文件和目录,或 C:\Windows 等
Command1.Caption = "查找"
Else
Command1.Caption = "查找"
End If
End Sub
Private Sub FindDirFile(ByVal nPath As String)
Dim I As Long, nDir As String, Ci As Long
ctFind = True
List1.Clear: List2.Clear
If Right(nPath, 1) <> "\" Then nPath = nPath & "\"
List1.AddItem "查找 " & nPath: List2.AddItem nPath
File1.Pattern = "*"
File1.System = True: File1.Hidden = True: File1.ReadOnly = True
On Error GoTo Cuo
Dir1.Path = nPath
On Error GoTo 0
Do
If List2.ListCount = 0 Then Exit Do
nPath = List2.List(0)
List2.RemoveItem 0
Dir1.Path = nPath
For I = 0 To Dir1.ListCount - 1
GoSub ShowGe
nDir = Dir1.List(I)
If Right(nDir, 1) <> "\" Then nDir = nDir & "\"
List1.AddItem "■" & nDir
List2.AddItem nDir
Next
File1.Path = nPath
For I = 0 To File1.ListCount - 1
GoSub ShowGe
List1.AddItem " " & nPath & File1.List(I)
Next
Loop
Label1.Caption = "查找完毕,共找到 " & List1.ListCount & " 个条目"
ctFind = False
Exit Sub
Cuo:
List1.AddItem "起始目录不存在:" & nPath
ctFind = False
Exit Sub
ShowGe:
Ci = Ci + 1
If Ci < 99 Then Return
Ci = 0
Label1.Caption = "已找到 " & List1.ListCount & " 个:" & nPath
DoEvents
If ctFind Then Return
End Sub