8wDlpd.png
8wDFp9.png
8wDEOx.png
8wDMfH.png
8wDKte.png

使用 VBA 循环遍历文件夹中的文件?

zest16 1月前

75 0

我想使用 Excel 2010 中的 vba 循环遍历目录的文件。在循环中,我需要:文件名和文件格式化的日期。我已编写了以下代码...

Excel 2010 中的循环遍历目录的文件

在循环中,我需要:

  • 文件名,以及
  • 文件格式化的日期。

我编写了以下代码,如果文件夹中的文件不超过 50 个,则运行良好,否则速度会非常慢(我需要它处理包含超过 10000 个文件的文件夹)。此代码的唯一问题是查找操作 file.name 需要花费大量时间。

代码可以运行但是速度太慢了(每 100 个文件需要 15 秒):

Sub LoopThroughFiles()
   Dim MyObj As Object, MySource As Object, file As Variant
   Set MySource = MyObj.GetFolder("c:\testfolder\")
   For Each file In MySource.Files
      If InStr(file.name, "test") > 0 Then
         MsgBox "found"
         Exit Sub
      End If
   Next file
End Sub

问题解决:

  1. 我的问题已通过以下解决方案解决,使用 Dir 特定方式(15000 个文件需要 20 秒)并使用命令检查时间戳 FileDateTime .
  2. 考虑到下面的另一个答案,20 秒减少到少于 1 秒。
帖子版权声明 1、本帖标题:使用 VBA 循环遍历文件夹中的文件?
    本站网址:http://xjnalaquan.com/
2、本网站的资源部分来源于网络,如有侵权,请联系站长进行删除处理。
3、会员发帖仅代表会员个人观点,并不代表本站赞同其观点和对其真实性负责。
4、本站一律禁止以任何方式发布或转载任何违法的相关信息,访客发现请向站长举报
5、站长邮箱:yeweds@126.com 除非注明,本帖由zest16在本站《file》版块原创发布, 转载请注明出处!
最新回复 (0)
  • sxs 1月前 0 只看Ta
    引用 2

    试试这个。( 链接 )

    Private Sub CommandButton3_Click()
    
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim xWs As Worksheet
    Dim xWb As Workbook
    Dim FolderName As String
    Application.ScreenUpdating = False
    Set xWb = Application.ThisWorkbook
    DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
    FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
    MkDir FolderName
    For Each xWs In xWb.Worksheets
        xWs.Copy
        If Val(Application.Version) < 12 Then
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            Select Case xWb.FileFormat
                Case 51:
                    FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If Application.ActiveWorkbook.HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56:
                    FileExtStr = ".xls": FileFormatNum = 56
                Case Else:
                    FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
        xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
        Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
        Application.ActiveWorkbook.Close False
    Next
    MsgBox "You can find the files in " & FolderName
    Application.ScreenUpdating = True
    
    End Sub
    
  • 假设此代码的用户将使用 Option Explicit,那么您需要声明 f 即 Dim f As Variant,否则代码将无法运行

  • 这里返回一个集合,然后您可以对其进行迭代 - 如果您想要的不仅仅是文件名,您可以使用字典

    Sub test()
        Dim c As Collection
        Set c = LoopThroughFiles(ThisWorkbook.Path, ".xlsx")
        For Each f In c
            Debug.Print f
        Next
    End Sub
    
    Function LoopThroughFiles(inputDirectoryToScanForFile, filenameCriteria) As Collection
        Dim col As New Collection
        Dim StrFile As String
        'Debug.Print "in LoopThroughFiles. inputDirectoryToScanForFile: ", inputDirectoryToScanForFile
        StrFile = Dir(inputDirectoryToScanForFile & "\*" & filenameCriteria)
        Do While Len(StrFile) > 0
            '//Debug.Print StrFile
            col.Add StrFile
            StrFile = Dir
        Loop
        Set LoopThroughFiles = col
    End Function
    
  • 从技术上讲,这是提问者正在使用的方法,只是他们没有包含参考资料,这会减慢此方法的速度。

  • Dir 当我处理来自其他文件夹的文件时,功能很容易失去焦点。

    我使用该组件获得了更好的结果 FileSystemObject .

    完整示例如下:

    http://www.xl-central.com/list-files-fso.html

    不要忘记在 Visual Basic 编辑器中设置对 Microsoft Scripting Runtime (通过使用工具 > 引用)

    尝试一下!

  • 非常感谢,只是建议在 GetFileList 函数的末尾添加一个 Else:If m_lNext Then ...Else ... ReDim GetFileList(0) As String。正如这里建议的那样:[.com/a/35221544/6406135]

  • @jechaviz GetFileList 方法返回一个字符串数组。您可能只需遍历该数组并将项目添加到 ListView 或类似的东西。有关如何在列表视图中显示项目的详细信息可能超出了本文的范围。

  • eb1 1月前 0 只看Ta
    引用 9

    Dir 函数是可行的方法,但 the problem is that you cannot use the Dir function recursively ,如此处所述 ,在底部 .

    我处理这个问题的方法是使用函数 Dir 获取目标文件夹的所有子文件夹并将它们加载到数组中,然后将数组传递到递归函数中。

    这是我编写的一个可以实现此功能的一个类,它包括搜索过滤器的功能。( 您必须原谅匈牙利表示法,因为它是在匈牙利表示法风靡一时时编写的。) )

    Private m_asFilters() As String
    Private m_asFiles As Variant
    Private m_lNext As Long
    Private m_lMax As Long
    
    Public Function GetFileList(ByVal ParentDir As String, Optional ByVal sSearch As String, Optional ByVal Deep As Boolean = True) As Variant
        m_lNext = 0
        m_lMax = 0
    
        ReDim m_asFiles(0)
        If Len(sSearch) Then
            m_asFilters() = Split(sSearch, "|")
        Else
            ReDim m_asFilters(0)
        End If
    
        If Deep Then
            Call RecursiveAddFiles(ParentDir)
        Else
            Call AddFiles(ParentDir)
        End If
    
        If m_lNext Then
            ReDim Preserve m_asFiles(m_lNext - 1)
            GetFileList = m_asFiles
        End If
    
    End Function
    
    Private Sub RecursiveAddFiles(ByVal ParentDir As String)
        Dim asDirs() As String
        Dim l As Long
        On Error GoTo ErrRecursiveAddFiles
        'Add the files in 'this' directory!
    
    
        Call AddFiles(ParentDir)
    
        ReDim asDirs(-1 To -1)
        asDirs = GetDirList(ParentDir)
        For l = 0 To UBound(asDirs)
            Call RecursiveAddFiles(asDirs(l))
        Next l
        On Error GoTo 0
    Exit Sub
    ErrRecursiveAddFiles:
    End Sub
    Private Function GetDirList(ByVal ParentDir As String) As String()
        Dim sDir As String
        Dim asRet() As String
        Dim l As Long
        Dim lMax As Long
    
        If Right(ParentDir, 1) <> "\" Then
            ParentDir = ParentDir & "\"
        End If
        sDir = Dir(ParentDir, vbDirectory Or vbHidden Or vbSystem)
        Do While Len(sDir)
            If GetAttr(ParentDir & sDir) And vbDirectory Then
                If Not (sDir = "." Or sDir = "..") Then
                    If l >= lMax Then
                        lMax = lMax + 10
                        ReDim Preserve asRet(lMax)
                    End If
                    asRet(l) = ParentDir & sDir
                    l = l + 1
                End If
            End If
            sDir = Dir
        Loop
        If l Then
            ReDim Preserve asRet(l - 1)
            GetDirList = asRet()
        End If
    End Function
    Private Sub AddFiles(ByVal ParentDir As String)
        Dim sFile As String
        Dim l As Long
    
        If Right(ParentDir, 1) <> "\" Then
            ParentDir = ParentDir & "\"
        End If
    
        For l = 0 To UBound(m_asFilters)
            sFile = Dir(ParentDir & "\" & m_asFilters(l), vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem)
            Do While Len(sFile)
                If Not (sFile = "." Or sFile = "..") Then
                    If m_lNext >= m_lMax Then
                        m_lMax = m_lMax + 100
                        ReDim Preserve m_asFiles(m_lMax)
                    End If
                    m_asFiles(m_lNext) = ParentDir & sFile
                    m_lNext = m_lNext + 1
                End If
                sFile = Dir
            Loop
        Next l
    End Sub
    
  • Dir 还会被其他 Dir 命令中断,因此如果您运行包含 Dir 的子程序,它可以在原始子程序中“重置”它。按照原始问题使用 FSO 可以消除此问题。编辑:刚刚看到下面 @LimaNightHawk 的帖子,同样的事情

  • 但是 Dir 不会遍历整个目录树。如果需要,请访问:analystcave.com/vba-dir-function-how-to-traverse-directories/…

  • 还有一个问题。如果 DIR 从最近的文件开始循环,我可以大大提高速度。你有什么办法吗?

  • 引用 13

    太好了,非常感谢。我确实使用 Dir,但我不知道你也可以这样使用它。此外,使用命令 FileDateTime 我的问题解决了。

  • Dir 看上去非常快。

    Sub LoopThroughFiles()
        Dim MyObj As Object, MySource As Object, file As Variant
       file = Dir("c:\testfolder\")
       While (file <> "")
          If InStr(file, "test") > 0 Then
             MsgBox "found " & file
             Exit Sub
          End If
         file = Dir
      Wend
    End Sub
    
  • 对于那些看到 Kar.ma 的评论并且想知道同样的事情的人来说,While 循环中的 StrFile = Dir 只是将 StrFile 设置为先前设置的 Dir(\'c:\testfolder\*test*\') 中找到的下一个文件。例如:如果有一个 test1.xlsx 和一个 test2.xlsx,则 Debug.Print StrFile 将首先给出 test1,然后 StrFile = Dir 将找到下一个匹配项,即 test2(因此停留在 while 循环中)。希望这能让事情清楚一点。

  • 我不明白 StrFile = Dir 这一行。这对我来说不起作用。我改用了 Output = StrFile。

  • @hamish,您可以更改其参数以返回不同类型的文件(隐藏、系统等) - 请参阅 MS 文档:learn.microsoft.com/en-us/office/vba/language/reference/…

  • 我不认为通过那个改进水平(20 - xxx 次) - 我认为是通配符产生了差异。

  • 太棒了。这将运行时间从 20 秒缩短到了不到 1 秒。这是一个很大的改进,因为代码会经常运行。谢谢!

  • Dir 使用通配符,因此您可以提前添加过滤器 test 并避免测试每个文件,从而

    Sub LoopThroughFiles()
        Dim StrFile As String
        StrFile = Dir("c:\testfolder\*test*")
        Do While Len(StrFile) > 0
            Debug.Print StrFile
            StrFile = Dir
        Loop
    End Sub
    
返回
作者最近主题: