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

Question

In my folder, I have different types of files:

.mp4 .wav .out .outreview

I am using a VBA code in excel to make a list of all of the files according to their file extension. As seen in the screenshot:

To do this, I use the following code four times, each time I replace the file extension and adjust the column references:

this is the example code for the first column, the video files, .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

I repeat it for .wav and .outreview files. But I use the following code for .out files, because, otherwise, it pulls up all the .out and . outreview files in the .out column, which I don't want.

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

Question: how can I pull the last modified date ONLY for .out files and put them in their corresponding cells in column D ?

And how can I combine all these codes into one code so that I don't repeat this for each file extension? Thanks



UPDATE :



this update is after the answer provided by Jeanno :

This answers my question. here is the Jeanno's corrected version of the code.

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

Not sure about the modified date portion of the question, however, for the other, just include the extension in a row near the column header. Then use that to feed another loop.

so for example:

1) create a new row between rows 3 and 4. 2) in this new row 4, column A, store ".mp4". In B, ".wav", etc. 3) change your code to add another loop: (and use that loop # to reference the proper columns)

  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

A different approach:

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

This will do everything in one shot. i haven't tested it. Basically I use the Like operator and FileDateTime function. Let me know if that worked for you

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