时间戳

首页 > 解决方案 > 通过路径

excel - 通过路径

问题描述

我有一个问题：我想构建一个从 .xlsm 文件中获取信息的工具。这些文件位于子文件夹中。所以我需要检查该路径中的所有文件夹并进入子文件夹“eingang”。该子文件夹包括许多其他文件夹，您可以在其中找到 .xlsm 文件。之后，我需要保护一些信息，例如“最后使用”或每个文件的创建日期，并将其打印在工作表上。

所以我的想法是，使用“do while”循环检查每个主文件夹，并使用新的“do while”循环检查子文件夹“eingang”等。

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

这是我检查每个文件夹的想法。

我希望你能帮助我。当您需要更多信息时，请随时询问。

标签： excelvbaloops

解决方案

这是为了向您展示有关如何将文件的某些属性直接打印到工作表的逻辑：

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

推荐阅读