Excel VBA通​​过多个文件扩展名和最后修改日期获取文件列表

Question

在我的文件夹中，我有不同类型的文件：

.mp4 .wav .out .outreview

我在 excel 中使用 VBA 代码根据文件扩展名列出所有文件。如屏幕截图所示：

为此，我使用以下代码四次，每次替换文件扩展名并调整列引用：

这是第一列，视频文件，.mp4 的示例代码：

Sub getfilelistfromfolder()
    Dim varDirectory As Variant
    Dim flag As Boolean
    Dim i As Long
    Dim strDirectory As String
    Dim Desired As String

    strDirectory = Application.ActiveWorkbook.Path & "\"
    i = 1
    flag = True
    varDirectory = Dir("C:\Users\Folder\*.mp4", vbNormal)
    Range("A5:A100").Select
    Selection.ClearContents

    While flag = True
        If varDirectory = "" Then
            flag = False
        Else
            Cells(i + 4, 1) = varDirectory
            varDirectory = Dir
            i = i + 1
        End If
    Wend
End Sub

我对 .wav 和 .outreview 文件重复一遍。 但是我将以下代码用于 .out 文件，因为否则它会提取所有 .out 和 . .out 列中的 outreview 文件，这是我不想要的。

Sub getfilelistfromfolder()
    Dim varDirectory As Variant
    Dim flag As Boolean
    Dim i As Long
    Dim strDirectory As String
    Dim Desired As String

Desired = ".out"

strDirectory = Application.ActiveWorkbook.Path & "\"
i = 1
flag = True
varDirectory = Dir("C:\Users\Folder\", vbNormal)

While flag = True
    If varDirectory = "" Then
        flag = False
    Else
        If Right(varDirectory, 4) = Desired Then
            Cells(i + 4, 3) = varDirectory
            i = i + 1
        End If
        varDirectory = Dir
    End If
Wend
End Sub

问题：如何仅提取 .out 文件的最后修改日期，并将它们放在 列中的相应单元格中D？

我怎样才能将所有这些代码组合成一个代码，这样我就不会为每个文件扩展名重复这个？ 谢谢



更新：



此更新是在 Jeanno 提供的答案之后进行的：

这回答了我的问题。这是 Jeanno 的修正版代码。

Sub getfilelistfromfolder()
    Dim varDirectory As Variant
    Dim flag As Boolean
    Dim i As Long
    Dim strDirectory As String
    Dim Desired As String

    strDirectory = Application.ActiveWorkbook.Path & "\"
    i = 1
    flag = True
    varDirectory = Dir("C:\Users\folder\*", vbNormal)
    Range("A5:E100").clear

While flag = True
        If varDirectory = "" Then
            flag = False
        Else
        If varDirectory Like "*.mp4" Then
            Cells(i + 4, 1) = varDirectory
        End If
        If varDirectory Like "*.wav" Then
            Cells(i + 4, 2) = varDirectory
            i = i + 1
        End If
        If varDirectory Like "*.outreview" Then
            Cells(i + 4, 5) = varDirectory
        End If
        If varDirectory Like "*.out" Then
            Cells(i + 4, 4) = varDirectory
            Cells(i + 4, 3) = FileDateTime("C:\Users\folder\" & varDirectory)
        End If
        varDirectory = Dir
        End If
Wend
End Sub

Answer 1

这将一次性完成所有操作。我还没有测试过。基本上我使用Like 运算符和FileDateTime 函数。让我知道这是否对你有用

Sub getfilelistfromfolder()
    Dim varDirectory As Variant
    Dim flag As Boolean
    Dim i As Long
    Dim strDirectory As String
    Dim Desired As String

    strDirectory = Application.ActiveWorkbook.Path & "\"
    i = 1
    flag = True
    varDirectory = Dir("C:\Users\Folder\*", vbNormal)
    Range("A5:D100").Clear

    While flag = True
        If varDirectory = "" Then
            flag = False
        ElseIf varDirectory Like "*.mp4" Then
            Cells(i + 4, 1) = varDirectory
            Cells(i + 4, 3) = FileDateTime("C:\Users\Folder\" & varDirectory)
            varDirectory = Dir
            i = i + 1
        ElseIf varDirectory Like "*.wav" Then
            Cells(i + 4, 2) = varDirectory
            Cells(i + 4, 3) = FileDateTime("C:\Users\Folder\" & varDirectory)
            varDirectory = Dir
            i = i + 1
        ElseIf varDirectory Like "*.outreview" Then
            Cells(i + 4, 5) = varDirectory
            Cells(i + 4, 3) = FileDateTime("C:\Users\Folder\" & varDirectory)
            varDirectory = Dir
            i = i + 1
        ElseIf varDirectory Like "*.out" Then
            Cells(i + 4, 4) = varDirectory
            Cells(i + 4, 3) = FileDateTime("C:\Users\Folder\" & varDirectory)
            varDirectory = Dir
            i = i + 1
        End If
    Wend
End Sub

Answer 2

不确定问题的修改日期部分，但是，对于另一个，只需在列标题附近的一行中包含扩展名。然后用它来喂另一个循环。

例如：

1) 在第 3 行和第 4 行之间创建一个新行。 2) 在这个新的第 4 行 A 列中，存储“.mp4”。在 B 中，“.wav”等。 3）更改您的代码以添加另一个循环： （并使用该循环 # 来引用正确的列）

  Sub getfilelistfromfolder()
      Dim varDirectory As Variant
      Dim flag As Boolean
      Dim i As Long
      Dim strDirectory As String
      Dim Desired As String

  for x = 1 to 3

  Desired = Cells(4,x).Value

  strDirectory = Application.ActiveWorkbook.Path & "\"
  i = 1
  flag = True
  varDirectory = Dir("C:\Users\Folder\", vbNormal)

  While flag = True
      If varDirectory = "" Then
          flag = False
      Else
          If Right(varDirectory, 4) = Desired Then
              Cells(i + 4, x) = varDirectory
              i = i + 1
          End If
          varDirectory = Dir
      End If
  Wend
  next x

  End Sub

Answer 3

另一种方法：

Sub M_snb()
 c00 = "C:\Users\Folder\"
 sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & c00 & "*.*"" /b/a-d").stdout.readall, vbCrLf)

 ReDim sp(1 To UBound(sn), 5)

 With CreateObject("scripting.filesystemobject")
  For j = 0 To UBound(sn)
   c01 = lcase(.getextensionname(c00 & sn(j)))
   If c01 <> "" And InStr("mp4wavoutoutreview", c01) Then sp(j, Application.Match(c01, Array("mp4", "wav", "out", "", "outreview"), 0)-1) = sn(j)
   If c01 = "out" Then sp(j, 4) = FileDateTime(c00 & sn(j))
  Next
 End With

 sheet1.cells(1).resize(ubound(sp),ubound(sp,2))=sp
End Sub