用于排除zip文件的代码

时间:2018-03-26 16:09:51

标签: vba

我有以下代码列出目录中的报告(文件和文件夹)。 我想从列表中排除一种类型:Zip文件夹。

想知道如何以及在何处加入此排除项?

Dim iRow

Sub ListFiles()
    iRow = 2
    Call ListMyFiles(Range("F1"), Range("F2"))
End Sub

Sub ListMyFiles(mySourcePath, IncludeSubfolders)
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    On Error Resume Next
    For Each myFile In mySource.Files
        iCol = 1
        Cells(iRow, iCol).Value = myFile.Path
        iCol = iCol + 1
        Cells(iRow, iCol).Value = myFile.Name
        iCol = iCol + 1
        Cells(iRow, iCol).Value = myFile.Size
        iCol = iCol + 1
        Cells(iRow, iCol).Value = myFile.DateLastModified
        iRow = iRow + 1
    Next
    If IncludeSubfolders Then
        For Each mySubFolder In mySource.SubFolders
            Call ListMyFiles(mySubFolder.Path, True)
        Next
    End If
End Sub

1 个答案:

答案 0 :(得分:1)

首先,您需要确定当前文件的文件扩展名。 因此,我们可以从文件名右侧搜索第一个.(点):

InStrRev(myFile.Name, ".") 'position of the first dot

使用此位置,我们可以从文件名中提取文件扩展名:

LCase$(Right$(myFile.Name, Len(myFile.Name) - InStrRev(myFile.Name, ".")))
'LCase is used to transform the extension to lower case letters so it is case insensitive

因此,我们可以通过检查文件扩展名轻松地从列表中排除所有zip文件:

If LCase$(Right$(myFile.Name, Len(myFile.Name) - InStrRev(myFile.Name, "."))) <> "zip" Then
     'file is no zip file
End If
  • 我还建议您使用Option Explicit并正确声明所有变量类型,这样您就不会遇到任何类型问题。

  • 也不要使用On Error Resume Next,这是一种非常糟糕的做法。它会让你对任何错误消息视而不见,但错误仍然存​​在,你只是看不到它们。相反,实现正确的错误处理,如果发生错误则显示消息,因此我们至少知道出现了问题。

  • 请勿使用Call声明,因此已弃用且不再需要。

所以我们最终得到这样的东西:

Option Explicit 'force variable declare

Public iRow As Long 'always declare a type

Public Sub ListFiles()
    iRow = 2
    ListMyFiles "C:\Temp", False 'don't use call
End Sub

Public Sub ListMyFiles(mySourcePath As String, IncludeSubfolders As Boolean) 'declare types for variables to avoid odd behaviors
    Dim MyObject As FileSystemObject 'declare ALL variables and specify a type
    Set MyObject = New Scripting.FileSystemObject

    Dim mySource As Folder
    Set mySource = MyObject.GetFolder(mySourcePath)

    Dim iCol As Long: iCol = 1 'starting column

    'On Error Resume Next 'don't use this or you are blind! use a proper error handling if needed
    Dim myFile As File
    For Each myFile In mySource.Files
        If LCase$(Right$(myFile.Name, Len(myFile.Name) - InStrRev(myFile.Name, "."))) <> "zip" Then 'exclude zip file extensions
            Cells(iRow, iCol + 0).Value = myFile.Path 'count iCol from start value (reduces code)
            Cells(iRow, iCol + 1).Value = myFile.Name
            Cells(iRow, iCol + 2).Value = myFile.Size
            Cells(iRow, iCol + 3).Value = myFile.DateLastModified
            iRow = iRow + 1
        End If
    Next myFile

    If IncludeSubfolders Then
        Dim mySubFolder As Folder
        For Each mySubFolder In mySource.SubFolders
            ListMyFiles mySubFolder.Path, True 'don't use call
        Next mySubFolder
    End If
End Sub

编辑:
根据 @Ahmed Abdelhameed 的评论你也可以使用

LCase$(MyObject.GetExtensionName(myFile.Path))

而不是

LCase$(Right$(myFile.Name, Len(myFile.Name) - InStrRev(myFile.Name, ".")))

从文件中检索文件扩展名。 GetExtensionName甚至更快一点。