Go через Путь

Question

У меня проблема: я хочу создать инструмент, который берет информацию из файла .xlsm. Эти файлы находятся в подпапках. Поэтому мне нужно проверить все папки по этому пути и go в подпапке «eingang». Эта подпапка включает в себя множество других папок, в которых вы можете найти файлы .xlsm. После этого мне нужно сохранить некоторую информацию, такую ​​как «дата последнего использования» или дату создания каждого файла, и распечатать ее на рабочем листе.

Поэтому моя идея заключалась в том, чтобы использовать «do while» l oop для проверки каждую основную папку и проверьте с новым «do while» l oop для подпапки «eingang» et c.

Public Function DateienSuchen(Optional Ordnerpfad As String = "S:\Transfercenter", _
                              Optional Dateityp As String, _
                              Optional OhneUnterordner As Boolean) As String()

   Dim idx         As Long
   Dim lngTyp      As Long
   Dim strDir      As String
   Dim strAktDir   As String
   Dim colDir      As New Collection
   Dim arrResult() As String
   lngTyp = Len(Dateityp)
   If Right$(Ordnerpfad, 1) <> "S:\Transfercenter" Then
      Ordnerpfad = Ordnerpfad & "S:\Transfercenter"
   End If
   colDir.Add Ordnerpfad
   Do While colDir.Count > 0
      strAktDir = colDir.Item(1)
      colDir.Remove 1
      strDir = Dir$(strAktDir, vbDirectory)
      Do While Len(strDir) > 0
         If (strDir <> ".") And (strDir <> "..") Then
                colDir.Add
         End If

         strDir = Dir$
      Loop
   Loop
    For Each strDir In colDir
      strAktDir = colDir.Item(1)
      colDir.Remove 1
      strAktDir = Dir$(strDir & "Eingang")
        Do While strAktDir <> ""

   Set colDir = Nothing
   DateienSuchen = arrResult
End Function

Это была моя идея проверить каждую папку.

Я надеюсь, что вы можете мне помочь. Если вам нужна дополнительная информация, не стесняйтесь спрашивать.

Answer 1

Это чтобы показать вам логи c о том, как напечатать непосредственно на ваш лист некоторые атрибуты для файлов:

Option Explicit
Sub Test()

    Dim fso As New FileSystemObject 'You need the Microsoft Scripting Runtime library under tools-references
    Dim mainFolder As Folder: Set mainFolder = fso.GetFolder("Your main folder path")
    Dim SubFolder As Folder
    Dim myFile As File
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet name where you want to print")
    With ws
        Dim lrow As Long
        For Each SubFolder In mainFolder.SubFolders
            For Each myFile In SubFolder.Files
                If myFile.Type = "your filetype" Then
                    lrow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'next blank row in column A
                    .Cells(lrow, 1) = myFile.Name
                    .Cells(lrow, 2) = myFile.DateCreated
                    .Cells(lrow, 3) = myFile.DateLastModified
                    .Cells(lrow, 4) = myFile.DateLastAccessed
                    .Cells(lrow, 5) = myFile.Size
                End If
            Next myFile
        Next SubFolder
    End With

End Sub