我是写在模块里的
Public Sub cNewfile(Mypath As String)
Dim Myname, Filelenm As String
Dim Dirnum() As String
Dim m, n, idir As Long
If Right(Mypath, 1) <> "\" Then Mypath = Mypath + "\"
Myname = Dir(Mypath, vbDirectory Or vbNormal Or vbReadOnly)
Do While Myname <> ""
If Myname <> "." And Myname <> ".." Then
If (GetAttr(Mypath & Myname) And vbDirectory) = vbDirectory Then '如果找到的是目录
idir = idir + 1
ReDim Preserve Dirnum(idir) As String
Dirnum(idir - 1) = Myname
Else
Form1.List5.AddItem TrimPath(Mypath & Myname)
'把找到的文件名显示到form1.list5
Form1.List3.AddItem FileDateTime(Mypath & Myname) '把找到的文件时间显示到form1.list3
Form1.List4.AddItem Mypath & Myname '把文件路径显示到form1.list4
End If
End If
Myname = Dir '搜索下一项
Loop
For i = 0 To idir - 1
Call Cdir(Mypath + Dirnum(i)) '在子目录中搜索
Next
ReDim Dirnum(0) As String
Form1.List1.Clear '保留文件代码
For m = 0 To (Form1.List5.ListCount - 1)
If InStr(Form1.List5.List(m), " ") > 0 Then
n = Len(Left(Form1.List5.List(m), InStr(Form1.List5.List(m), " ")))
Form1.List1.AddItem Left(Form1.List5.List(m), n - 1)
End If
Next
Form1.List2.Clear
For i = 0 To Form1.List5.ListCount - 1
'保留除文件代码之外的内容,并删掉第一个空格
Filelenm = Right(Form1.List5.List(i), Len(Form1.List5.List(i)) - InStr(Form1.List5.List(i), " "))
Do While InStr(Filelenm, " ") = 1
Filelenm = Right(Filelenm, Len(Filelenm) - 1)
Loop
Form1.List2.AddItem Filelenm
Next
End Sub
Public Sub Cdir(Mypath As String)
Dim Myname, MyPath3, Mypath4 As String
Dim Dirnum(1 To 90000) As String
Dim m, n As Long
Dim idir As Long
MyPath3 = Mypath
Do While InStr(MyPath3, "\") > 0
i = Len(MyPath3)
j = InStr(MyPath3, "\")
MyPath3 = Right(MyPath3, (i - j))
Loop
Form1.List5.AddItem MyPath3 '将文件夹名加入list3
If Right(Mypath, 1) <> "\" Then Mypath = Mypath + "\"
Form1.List4.AddItem Mypath '将路径名加入list5
Myname = Dir(Mypath, vbNormal Or vbReadOnly)
Do While Myname <> ""
If Myname <> "." And Myname <> ".." Then
idir = idir + 1
Dirnum(idir) = FileDateTime(Mypath & Myname)
End If
Myname = Dir '搜索下一项
Loop
If idir > 0 Then '比较出最近的文件修改时间来作为文件夹的修改时间
If idir = 1 Then
Dirtime = Dirnum(1)
Else
For j = 1 To idir - 1
If Dirnum(j) > Dirnum(j + 1) Then
Dirtime = Dirnum(j)
Else
Dirtime = Dirnum(j + 1)
End If
Next
End If
End If
If Dirtime <> "" Then
Form1.List3.AddItem Dirtime
End If
End Sub
Public Function TrimPath(sPath As String) As String '获取不带扩展名的文件名称
Dim i As Integer, j As Integer
i = InStrRev(sPath, "\") + 1
j = InStrRev(sPath, ".")
TrimPath = Mid(sPath, i, j - i)
End Function
[
本帖最后由 linandceline 于 2015-4-30 08:40 编辑 ]