VBA找到多个文件 [英] VBA to find multiple files

问题描述

我有这个代码可以根据搜索字符串查找文件名（以及文件路径）。该代码在找到单个文件时工作正常。我想要这个宏找到多个文件，并使用逗号分隔他们的名字。

I have this code which finds file names(along with file paths) based on search string.This code works fine in finding single files. I would like this macro to find multiple files and get their names displayed separated using a comma.

Function FindFiles(path As String, SearchStr As String)

          Dim FileName As String   ' Walking filename variable.
          Dim DirName As String    ' SubDirectory Name.
          Dim dirNames() As String ' Buffer for directory name entries.
          Dim nDir As Integer      ' Number of directories in this path.
          Dim i As Integer         ' For-loop counter.
          Dim Name As String
          Dim Annex As String

          On Error GoTo sysFileERR
          If Right(path, 1) <> "\" Then path = path & "\"
          ' Search for subdirectories.
          nDir = 0
          ReDim dirNames(nDir)
          DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _
    Or vbSystem)  ' Even if hidden, and so on.
          Do While Len(DirName) > 0
             ' Ignore the current and encompassing directories.
             If (DirName <> ".") And (DirName <> "..") Then
                ' Check for directory with bitwise comparison.
                If GetAttr(path & DirName) And vbDirectory Then
                   dirNames(nDir) = DirName
                   DirCount = DirCount + 1
                   nDir = nDir + 1
                   ReDim Preserve dirNames(nDir)
                   'List2.AddItem path & DirName ' Uncomment to list
                End If                           ' directories.
    sysFileERRCont:
             End If
             DirName = Dir()  ' Get next subdirectory.
          Loop

          ' Search through this directory and sum file sizes.
          FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem _
          Or vbReadOnly Or vbArchive)
          'Sheet1.Range("C1").Value2 = path & "\" & FileName
          While Len(FileName) <> 0
             FindFiles = path & "\" & FileName
             FileCount = FileCount + 1
             ' Load List box
            ' Sheet1.Range("A1").Value2 = path & FileName & vbTab & _
                FileDateTime(path & FileName)   ' Include Modified Date
             FileName = Dir()  ' Get next file.
          Wend

          ' If there are sub-directories..
          If nDir > 0 Then
             ' Recursively walk into them
             For i = 0 To nDir - 1
               FindFiles = path & "\" & FileName
             Next i
          End If

    AbortFunction:
          Exit Function
    sysFileERR:
          If Right(DirName, 4) = ".sys" Then
            Resume sysFileERRCont ' Known issue with pagefile.sys
          Else
            MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
             "Unexpected Error"
            Resume AbortFunction
          End If
          End Function



          Sub Find_Files()
          Dim SearchPath As String, FindStr As String, SearchPath1 As String
          Dim FileSize As Long
          Dim NumFiles As Integer, NumDirs As Integer
          Dim Filenames As String, Filenames1 As String
          Dim r As Range
          'Screen.MousePointer = vbHourglass
          'List2.Clear

          For Each cell In Range("SS")
          SearchPath = Sheet3.Range("B2").Value2
          SearchPath1 = Sheet3.Range("B3").Value2

          FindStr = Cells(cell.Row, "H").Value
          Filenames = FindFiles(SearchPath, FindStr)
          Filenames1 = FindFiles(SearchPath1, FindStr)
          'Sheet1.Range("B1").Value2 = NumFiles & " Files found in " & NumDirs + 1 & _
           " Directories"
          Cells(cell.Row, "F").Value = Filenames
          Cells(cell.Row, "G").Value = Filenames1

          'Format(FileSize, "#,###,###,##0") & " Bytes"
          'Screen.MousePointer = vbDefault
          Next cell

          End Sub

$ b $

推荐答案

我意识到这个问题很旧，但是没有答复以下是查找多个文件及其路径的快速方法。 VBA的 DIR 功能并不是非常方便，但CMD的 DIR 功能经过优化，拥有大量的命令行开关，使其只返回符合条件的文件（甚至只返回文件夹）。诀窍是从WScript shell调用 DIR ，以便输出可以由VBA解析。

I realize this question is very old, but it is unanswered. Here is a quick method for finding multiple files and their paths. VBA's DIR function isn't really very handy, but CMD's DIR function is well optimized and has a plethora of command line switches to make it return only files (or even just folders) that match your criteria. The trick is to call DIRfrom a WScript shell so that the output can be parsed by VBA.

例如，这段代码将会发现您的系统上的每个文件都以配置开头。

For example, this snippet of code will find every file on your system that starts with config.

Dim oShell As Object 'New WshShell if you want early binding
Dim cmd As Object 'WshExec if you want early binding
Dim x As Integer
Const WshRunning = 0

Set oShell = CreateObject("Wscript.Shell")
Set cmd = oShell.Exec("cmd /c ""Dir c:\config* /a:-d /b /d /s""")

Do While cmd.Status = WshRunning
    DoEvents
Loop

Debug.Print cmd.StdOut.ReadAll
Set oShell = Nothing
Set cmd = Nothing

这篇关于VBA找到多个文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！