当前位置:编程学习 > VB >>

vb统计某目录下文件及子文件夹下某个扩展名文件数量

需要设计一个函数 形如abc("c:\abc\","*.txt")

功能,统计出c盘abc下,及其abc下所有子文件夹以及子文件的子文件....所有扩展名为*.txt的文件数量  --------------------编程问答-------------------- Dim strFile As String, n As Long

strFile = Dir("c:\abc\*.txt")

Do Until strFile = ""
    n = n + 1
    strFile = Dir()
Loop --------------------编程问答--------------------

Option Explicit
Private Const MAX_PATH = 260
Private Const UnicodeTypeLib = True
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal sDrive As String) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long

Private Function FindFiles(sTarget As String, Optional ByVal Start As String) As Collection
    Dim ab() As Byte
    Static TypeDrev As String
    Dim hFiles As Long, f As Boolean
    Static sName As String, sSpec As String, nFound As New Collection
    Static fd As WIN32_FIND_DATA, iLevel As Long
    Dim sEmpty, INVALID_HANDLE_VALUE
          
    If Start = sEmpty Then Start = CurDir$
    If iLevel = 0 Then
        Set nFound = Nothing
        Start = NormalizePath(Start)
    End If
    iLevel = iLevel + 1
    hFiles = FindFirstFile(Start & "*.*", fd)
    f = (hFiles <> INVALID_HANDLE_VALUE)
    Do While f
        ab = fd.cFileName
        sName = ByteZToStr(ab)
        If Left$(sName, 1) <> "." Then
            sSpec = Start & sName
            If fd.dwFileAttributes And vbDirectory Then
                DoEvents
                FindFiles sTarget, sSpec & "\"
            Else
                If InStr(sTarget, "*") > 0 Then
                    If StrComp(Right$(sName, 3), Right$(sTarget, 3), 1) = 0 Then
                       nFound.Add sSpec
                    ElseIf StrComp(sName, sTarget, 1) = 0 Then
                       nFound.Add sSpec
                    End If
                End If
            End If
        End If
        f = FindNextFile(hFiles, fd)
    Loop
    f = FindClose(hFiles)
    Set FindFiles = nFound
    iLevel = iLevel - 1

End Function
Private Function ByteZToStr(ab() As Byte) As String
    If UnicodeTypeLib Then
        ByteZToStr = ab
    Else
        ByteZToStr = StrConv(ab, vbUnicode)
    End If
    ByteZToStr = Left$(ByteZToStr, lstrlen(ByteZToStr))
End Function

Private Function NormalizePath(sPath As String) As String
    If Right$(sPath, 1) <> "\" Then
        NormalizePath = sPath & "\"
    Else
        NormalizePath = sPath
    End If
End Function

Private Sub Command1_Click()
    Dim Num As Long
    Num = FindFiles("*.txt", "c:\abc").Count
    MsgBox Num
End Sub

--------------------编程问答--------------------
引用 2 楼 chinaboyzyq 的回复:
VB code

Option Explicit
Private Const MAX_PATH = 260
Private Const UnicodeTypeLib = True
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Private……


始终返回0 --------------------编程问答-------------------- 自己解决了

原来微软提供了 

http://support.microsoft.com/kb/185476 --------------------编程问答--------------------
引用 2 楼 chinaboyzyq 的回复:
VB code

Option Explicit
Private Const MAX_PATH = 260
Private Const UnicodeTypeLib = True
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Private……


标记大侠这个帖子。有时间用起来。 --------------------编程问答--------------------
引用 3 楼 ngqd2000 的回复:
始终返回0

不可能,看你C盘下是否有ABC文件夹,文件内是否有.txt文件,这个程序可以遍历abc文件夹下的所有文件夹里的文件。

复制帖,你总会吧,这个程序是我测试过的,没有问题。 --------------------编程问答-------------------- 复制粘贴你总会吧,在C盘根目录下建立好ABC文件,在里复制好几个txt文件,然后复制粘贴我2楼的帖子到你的form,然后测试。
--------------------编程问答-------------------- 简单的

Public Function sta_FileCount(sDirectory As String, sExt As String) As Long
    Dim FileNum As Integer, FileName As String, tmpStr As String
    Dim mCount As Long
    If Dir(sDirectory, vbDirectory) = "" Then Exit Function
    FileName = sDirectory & "\tmp.dat"
    DoEvents
    Shell "cmd /c tree /f " & sDirectory & " >" & FileName
    FileNum = FreeFile
    Open FileName For Input As #FileNum
    While Not EOF(FileNum)
        Line Input #FileNum, tmpStr
        If tmpStr Like sExt Then mCount = mCount + 1
    Wend
    sta_FileCount = mCount
    Close
End Function

要注意的是,当目录下文件很多时,需要异步执行shell --------------------编程问答-------------------- 学习了,顶,,,,,,
补充:VB ,  基础类
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,