Question

我有很多文件夹中都有日期名称。

如果我有三个文件夹分别名为20150605abcdef，20161204ghijk，20180612ikled。

我想编写一个VBA代码，该代码将返回具有最新日期的文件夹的目录。

在这种情况下，它将返回20180612ikled。

Answer 1

将其放在Excel中。然后将该文件移动到结构中的第一个Folder文件夹中，然后启动Macro ReadStructure。它将以清晰的树状结构将所有文件夹和子文件夹中的所有数据写入excel的第一页。然后，您可以使用Excel内置工具来查找日期，例如ex。过滤列表。

我为您翻译了德语版本。非常抱歉，如果某些部分仍使用德语Folder = Ordner，Spalte = Column，Zeile = Row，Pfad = Path。那部分我很懒惰

Option Explicit
Sub ReadStructure()
 Dim lngZeile As Long
 Dim lngSpalte As Long
 Dim strPFad As String

strPFad = ThisWorkbook.Path
 'Clear all cells form sheet 1
 sheet1.Cells.ClearContents
 sheet1.Range("A1").Value = strPFad

 lngZeile = 2

 Call ReadFilesFolder(strPFad, lngZeile, lngSpalte)

End Sub

Sub ReadFilesFolder(strPFad As String, ByRef lngZeile, ByRef lngSpalte)

 Dim oFSO As Object
 Dim objOrdner As Object
 Dim objUnterordner As Object
 Dim objDatei As Object

 Set oFSO = CreateObject("Scripting.FileSystemObject")
 Set objOrdner = oFSO.getfolder(strPFad)

 lngSpalte = lngSpalte + 1
  'Check with loop for folders
  For Each objDatei In objOrdner.Files
    lngZeile = lngZeile + 1
    sheet1.Cells(lngZeile, lngSpalte).Value = objDatei.Name
    sheet1.Cells(lngZeile, lngSpalte).Font.Bold = True
  Next objDatei

  For Each objUnterordner In objOrdner.Subfolders
   lngZeile = lngZeile + 1
   sheet1.Cells(lngZeile, lngSpalte).Value = objUnterordner.Name & "\"
   sheet1.Cells(lngZeile, lngSpalte).Font.Bold = False
   Call ReadFilesFolder(objUnterordner.Path, lngZeile, lngSpalte)

  Next objUnterordner

  lngSpalte = lngSpalte - 1

  Set oFSO = Nothing

  Exit Sub

 Fehler:
  If Err.Number = 70 Then
  lngZeile = lngZeile + 1
  sheet1.Cells(lngZeile, lngSpalte).Value = "No Acess"
  End If
  lngSpalte = lngSpalte - 1
  Set oFSO = Nothing

  End Sub

根据文件夹名称中包含的日期返回最新的文件夹目录

1 个答案: