遍历指定目录的文件并返回

最新推荐文章于 2021-08-09 23:36:32 发布

guyehanxinlei

最新推荐文章于 2021-08-09 23:36:32 发布

阅读量918

点赞数

CC 4.0 BY-SA版权

文章标签： string function integer 扩展 path api

本文链接：https://blog.youkuaiyun.com/guyehanxinlei/article/details/2227348

'自定义数据类型FILETIME和WIN32_FIND_DATA的定义

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public 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

'声明相关API函数

Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

'*************************************************************************
'**函数名：fDelInvaildChr

'**功能描述：去掉固定长度字符串右边的NULL字符(ASCII值为0)和SPACE字符(ASCII值为32)函数

'*************************************************************************
Public Function fDelInvaildChr(str As String) As String
    Dim i As Integer
    On Error Resume Next
    For i = Len(str) To 1 Step -1
        If Asc(Mid(str, i, 1)) <> 0 And Asc(Mid(str, i, 1)) <> 32 Then
            fDelInvaildChr = Left(str, i)
            Exit For
        End If
    Next
End Function

'*************************************************************************
'**函数名：sDirTraversal
'**功能描述：将指定文件夹路径下且符合合法文件扩展名的文件详细路径添加到集合对象中

'*************************************************************************
Public Sub sDirTraversal(ByVal strPathName As String, ByRef colFileSet As Collection)
Dim sSubDir(200) As String '存放当前目录下的子目录,下标可根据需要调整

Dim iIndex As Integer '子目录数组下标

    Dim i As Integer '用于循环子目录的查找
    Dim lHandle As Long 'FindFirstFileA 的句柄
    Dim tFindData As WIN32_FIND_DATA '
    Dim strFileName As String '文件名

On Error Resume Next
'初始化变量

    i = 1
    iIndex = 0
    tFindData.cFileName = "" '初始化定长字符串
    lHandle = FindFirstFile(strPathName & "/*.*", tFindData)
    If lHandle = 0 Then '查询结束或发生错误
        Exit Sub
    End If

    strFileName = fDelInvaildChr(tFindData.cFileName)
    If tFindData.dwFileAttributes = &H10 Then '目录
        If strFileName <> "." And strFileName <> ".." Then
            iIndex = iIndex + 1
            sSubDir(iIndex) = strPathName & "/" & strFileName '添加到目录数组
        End If
    Else
        '检查文件扩展名称
        If CheckExp(Trim(strPathName & "/" & strFileName)) = True Then
            colFileSet.Add strPathName & "/" & strFileName
        End If
    End If

    '循环查找下一个文件，直到结束
    Do While True
        tFindData.cFileName = ""
        If FindNextFile(lHandle, tFindData) = 0 Then '查询结束或发生错误
            FindClose (lHandle)
            Exit Do
        Else
            strFileName = fDelInvaildChr(tFindData.cFileName)
            If tFindData.dwFileAttributes = &H10 Then
                If strFileName <> "." And strFileName <> ".." Then
                    iIndex = iIndex + 1
                    sSubDir(iIndex) = strPathName & "/" & strFileName '添加到目录数组
                End If
            Else
                '检查文件扩展名称
                If CheckExp(Trim(strPathName & "/" & strFileName)) = True Then
                    colFileSet.Add strPathName & "/" & strFileName
                End If
            End If
        End If
    Loop

    '如果该目录下有目录，则根据目录数组递归遍历
    If iIndex > 0 Then
        For i = 1 To iIndex
            sDirTraversal sSubDir(i), colFileSet
        Next
    End If

End Sub

'*************************************************************************
'**函数名：CheckExp
'**功能描述：判断文件的扩展名称是否为程序所接受的类型

'*************************************************************************
Public Function CheckExp(strFileName As String) As Boolean
    Dim strExp() As String, strFileExp As String
    CheckExp = True
    strExp = Split(strFileName, ".")
    If UBound(strExp) < 1 Then
        CheckExp = False
        Exit Function
    Else
        strFileExp = UCase(strExp(UBound(strExp)))
        If strFileExp = "JPG" Or strFileExp = "JPEG" Then
            CheckExp = True
        Else
            CheckExp = False
        End If
    End If
End Function