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

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

所以例如：

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 2

另一种方法：

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

Answer 3

这将一举完成。我还没有测试过。基本上我使用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