Question

我试图获取目录中所有文件夹的列表。并有一个按钮，可以在列表上启用更新，而无需每次都重新创建。因此，只列出excel表格中尚未包含的新文件夹。

这是我工作的代码。但我希望它能够搜索工作表，如果文件夹已经存在，如果它然后跳过它，如果不是添加它。更新后，它在C列中按名称完成了过滤器

Sub folder_names_including_subfolder()
Application.ScreenUpdating = False
Dim fldpath
Dim fso As Object, j As Long, folder1 As Object
If ActiveSheet.Name = "test" Then
    fldpath = "Z:\\"
ElseIf ActiveSheet.Name = "test1" Then
    fldpath = "Y:\\"
End If
Cells(3, 1).Value = fldpath
Cells(4, 1).Value = "Path"
Cells(4, 2).Value = "Dir"
Cells(4, 3).Value = "Name"
Cells(4, 4).Value = "Folder Size"
Cells(4, 5).Value = "Date Created"
Cells(4, 6).Value = "Date Last Modified"
Cells(4, 7).Value = "Codec"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder1 = fso.GetFolder(fldpath)
get_sub_folder folder1
Set fso = Nothing
Range("A3").Font.Size = 9
ActiveWindow.DisplayGridlines = False
Range("A3:G" & Range("A4").End(xlDown).Row).Font.Size = 9
Range("A4:G4").Interior.Color = vbCyan
Application.ScreenUpdating = True
End Sub

Sub get_sub_folder(ByRef prntfld As Object)
Dim SubFolder As Object, subfld As Object, j As Long
For Each SubFolder In prntfld.SubFolders
j = Range("A3").End(xlDown).Row + 1
Cells(j, 1).Value = SubFolder.Path
Cells(j, 2).Value = Left(SubFolder.Path, InStrRev(SubFolder.Path, "\"))
Cells(j, 3).Value = SubFolder.Name
Cells(j, 4).Value = Application.WorksheetFunction.RoundDown((((SubFolder.Size / 1024) / 1024) / 1024), 2) & " " & "GB"
Cells(j, 5).Value = SubFolder.DateCreated
Cells(j, 6).Value = SubFolder.DateLastModified
With Cells(j, 7).Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Sheet3!$A$1:$A$5"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
End With
Next SubFolder
For Each subfld In prntfld.SubFolders
get_sub_folder subfld
Next subfld
Columns("C:F").AutoFit
Columns("G").ColumnWidth = 10
End Sub

Answer 1

在存储材料之前进行测试：

For Each SubFolder In prntfld.SubFolders
   checkit = SubFolder.Name
   If Application.WorksheetFunction.CountIf(Range("C:C"), checkit) = 0 Then
      j = Range("A3").End(xlDown).Row + 1
      Cells(j, 1).Value = SubFolder.Path
      Cells(j, 2).Value = Left(SubFolder.Path, InStrRev(SubFolder.Path, "\"))
      Cells(j, 3).Value = SubFolder.Name
      Cells(j, 4).Value = Application.WorksheetFunction.RoundDown((((SubFolder.Size / 1024) / 1024) / 1024), 2) & " " & "GB"
      Cells(j, 5).Value = SubFolder.DateCreated
      Cells(j, 6).Value = SubFolder.DateLastModified
      With Cells(j, 7).Validation
              .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
              xlBetween, Formula1:="=Sheet3!$A$1:$A$5"
              .IgnoreBlank = True
              .InCellDropdown = True
              .InputTitle = ""
              .ErrorTitle = ""
              .InputMessage = ""
              .ErrorMessage = ""
              .ShowInput = True
              .ShowError = True
      End With
   End If
Next SubFolder

列出目录中的文件夹，具有更新功能

1 个答案: