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

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

.mp4 .wav .out .outreview

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

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

这是第一列，video文件，.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和。 outoutview .out列中的文件，我不想要。

 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 

问题：我怎样才能把最后的修改date放在.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

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

不知道问题的修改date部分，但是，另一方面，只需在列标题附近的行中包含扩展。 然后用它来喂另一个循环。

例如：

1）在第3行和第4行之间创build一个新行。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/ad").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